parser.c

   1 #include <malloc.h>
   2 #include <math.h>
   3 #include <stdio.h>
   4 #include <stdlib.h>
   5 #include <string.h>
   6
   7 #include "debug.h"
   8
   9 #include "parser.h"
  10
  11 /* global variables */
  12
  13 double answer = 0;
  14
  15 #define DEFAULT_STORAGE_SIZE 10
  16 int storage_size = -1;
  17 double *storage = NULL;
  18
  19 int argument_size = 0;
  20 double *argument = NULL;
  21
  22 int stack_size = 0;
  23 double *stack = NULL;
  24
  25 #define DEFAULT_FORMAT "=> %.6g\n"
  26 char *format = NULL;
  27 char *minform = NULL;
  28
  29 workspace_t *programs = NULL;
  30 int nb_programs = 0;
  31
  32 /* compare codes */
  33
  34 int codecmp (char *ref, char *str)
  35 {
  36     int sig;
  37
  38     while (*ref != '\0') {
  39         if (*ref == '\t') {
  40              sig = (*str == '.') ? -1 : ((*str >= '0') && (*str <= '9'));
  41         } else {
  42             sig = *str - *ref;
  43         }
  44         if (sig != 0) {
  45             return (sig > 0) ? 1 : -1;
  46         }
  47         str++;
  48         ref++;
  49     }
  50
  51     return 0;
  52 }
  53
  54 /* calloc or die function */
  55
  56 void *callocordie (size_t count, size_t size)
  57 {
  58     if (count * size == 0) {
  59         return NULL;
  60     }
  61     void *new = calloc (count, size);
  62     if (new == NULL) {
  63         VERBOSE (ERROR, fprintf (stderr, "can't allocate memory\n"));
  64         exit (1);
  65     }
  66     return new;
  67 }
  68
  69 /* allocate new element */
  70
  71 element_t *newelement (func_t function, int nbops, int prio)
  72 {
  73     element_t *new = (element_t *) callocordie (1, sizeof (element_t));
  74     if (nbops) {
  75         new->ops = (element_t **) callocordie (nbops, sizeof (element_t *));
  76     }
  77     new->func = function;
  78     new->nbops = nbops;
  79     new->prio = prio;
  80
  81     return new;
  82 }
  83
  84 /* desallocate element */
  85
  86 void delelement (element_t *root)
  87 {
  88     if ((root != NULL) && (root != ERROR_OP)) {
  89         int i;
  90         for (i = 0; i < root->nbops; i++) {
  91             delelement (root->ops[i]);
  92         }
  93         if (root->nbops) {
  94             free (root->ops);
  95         }
  96         free (root);
  97     }
  98 }
  99
 100 /* duplicate element */
 101
 102 element_t *dupelement (element_t *root)
 103 {
 104     element_t *tmp = NULL;
 105     int i;
 106
 107     if ((root == NULL) || (root == ERROR_OP)) {
 108         return root;
 109     }
 110     tmp = newelement (root->func, root->nbops, root->prio);
 111     tmp->value = root->value;
 112     for (i = 0; i < root->nbops; i++) {
 113         tmp->ops[i] = dupelement (root->ops[i]);
 114     }
 115     return tmp;
 116 }
 117
 118 /* functions */
 119
 120 #define MAX_ARGS 100
 121
 122 #define NB_OPERATORS 14
 123 keyword_t operators[NB_OPERATORS] = {
 124     { "+\t", Add, 2, 1, 1},
 125     { "-\t", Sub, 2, 1, 1},
 126     { "*",   Mul, 2, 1, 2},
 127     { "/",   Div, 2, 1, 2},
 128     { "%",   Mod, 2, 1, 3},
 129     { "^",   Pow, 2, 1, 4},
 130     { "==",  Equal, 2, 2, -1},
 131     { "!=",  Diff, 2, 2, -1},
 132     { ">=",  Ge, 2, 2, -1},
 133     { "<=",  Le, 2, 2, -1},
 134     { ">",   Gt, 2, 1, -1},
 135     { "<",   Lt, 2, 1, -1},
 136     { "&",   And, 2, 1, -2},
 137     { "|",   Or, 2, 1, -2}
 138 };
 139
 140 #define NB_FUNCTIONS 42
 141 keyword_t functions[NB_FUNCTIONS] = {
 142     { "sqrt", Sqr, 1, 4, 5},
 143     { "pow",  Pow, 2, 3, 5},
 144     { "cos",  Cos, 1, 3, 5},
 145     { "sin",  Sin, 1, 3, 5},
 146     { "tan",  Tan, 1, 3, 5},
 147     { "acos", Acos, 1, 4, 5},
 148     { "asin", Asin, 1, 4, 5},
 149     { "atan", Atan, 1, 4, 5},
 150     { "ln",   Ln, 1, 2, 5},
 151     { "log",  Log, 1, 3, 5},
 152     { "exp",  Exp, 1, 3, 5},
 153     { "erfc", Erfc, 1, 4, 5},
 154     { "erf",  Erf, 1, 3, 5},
 155     { "abs",  Abs, 1, 3, 5},
 156     { "floor", Floor, 1, 5, 5},
 157     { "ceil", Ceil, 1, 4, 5},
 158     { "sto",  Store, 2, 3, 5},
 159     { "rcl",  Recall, 1, 3, 5},
 160     { "inc",  Inc, 1, 3, 5},
 161     { "dec",  Dec, 1, 3, 5},
 162     { "disp", Disp, 0, 4, 9},
 163     { "mem",  Mem, 1, 3, 5},
 164     { "clr",  Clear, 0, 3, 9},
 165     { "quit", Quit, 0, 4, 9},
 166     { "help", Help, 0, 4, 9},
 167     { "!",    Not, 1, 1, 6},
 168     { "cond", Cond, 3, 4, 5},
 169     { "while", While, 2, 5, 5},
 170     { "print", Print, 1, 5, 5},
 171     { "prog", Prog, 2, 4, 9},
 172     { "arg",  Arg, 1, 3, 5},
 173     { "call", Call, MAX_ARGS, 4, 5},
 174     { "ls",   List, 0, 2, 9},
 175     { "edit", Edit, 1, 4, 9},
 176     { "del",  Del, 1, 3, 9},
 177     { "get",  Get, 1, 3, 5},
 178     { "len",  Length, 0, 3, 5},
 179     { "pop",  Pop, 0, 3, 5},
 180     { "push", Push, 1, 4, 5},
 181     { "put",  Put, 2, 3, 5},
 182     { "set",  Set, MAX_ARGS, 3, 5},
 183     { "show",  Show, 0, 4, 5},
 184 };
 185
 186 #define NB_CONSTANTS 3
 187 keyword_t constants[NB_CONSTANTS] = {
 188     { "ans", Ans, 0, 3, 5},
 189     { "e",   E, 0, 1, 5},
 190     { "pi",  Pi, 0, 2, 5}
 191 };
 192
 193 #define NB_SYMBOLS 4
 194 char *symbols[NB_SYMBOLS] = {
 195     "(", ")", "{", "}"
 196 };
 197
 198 /* subparser function */
 199
 200 element_t *subparser (element_t **proot, char **pstr, func_t func, int nbops, int prio)
 201 {
 202     element_t *new = newelement (func, nbops, prio);
 203     new->ops[0] = *proot;
 204     new->ops[1] = parser (*pstr, pstr, new->prio);
 205     if ((new->ops[1] == NULL) || ((new->ops[1] != ERROR_OP) && (new->ops[1]->prio == 9))) {
 206         delelement (new->ops[1]);
 207         new->ops[1] = ERROR_OP;
 208     }
 209     if (new->ops[1] == ERROR_OP) {
 210         delelement (new);
 211         *proot = NULL;
 212         return ERROR_OP;
 213     }
 214     *proot = newelement (Val, 1, 5);
 215     (*proot)->ops[0] = new;
 216
 217     return *proot;
 218 }
 219
 220 /* parser function */
 221
 222 element_t *parser (char *str, char **next, int prio)
 223 {
 224     element_t *root = NULL;
 225     char *string = str;
 226     int i;
 227
 228     VERBOSE (DEBUG, fprintf (stdout, "Starting parsing\n"));
 229
 230     /* main loop */
 231     while (*str != '\0') {
 232         int found = 0;
 233         element_t *new = NULL;
 234         VERBOSE (INFO, fprintf (stdout, "Processing: %s\n", str));
 235
 236         /* end without printing */
 237
 238         if (*str == ';') {
 239             if (root) {
 240                 root->hidden = 1;
 241             }
 242             break;
 243         }
 244
 245         /* skip spaces and tabs */
 246
 247         if ((*str == ' ') || (*str == '\t')) {
 248             str++;
 249             continue;
 250         }
 251
 252         /* check for open brace */
 253
 254         if (*str == '{') {
 255             VERBOSE (DEBUG, fprintf (stdout, "start processing brace\n"));
 256             if (root != NULL) {
 257                 delelement (root);
 258                 return ERROR_OP;
 259             }
 260             root = newelement (Code, 0, 5);
 261
 262             do {
 263                 new = parser (str + 1, &str, 0);
 264                 if ((new == NULL) || ((new != ERROR_OP) && (new->prio == 9))) {
 265                     delelement (new);
 266                     new = ERROR_OP;
 267                 }
 268                 if (new == ERROR_OP) {
 269                     delelement (root);
 270                     return ERROR_OP;
 271                 }
 272                 element_t *newcode = newelement (Code, root->nbops + 1, 5);
 273                 for (i = 0; i < root->nbops; i++) {
 274                     newcode->ops[i] = root->ops[i];
 275                     root->ops[i] = NULL;
 276                 }
 277                 newcode->ops[root->nbops] = new;
 278                 delelement (root);
 279                 root = newcode;
 280             } while (*str == ',');
 281
 282             if (*str != '}') {
 283                 delelement (root);
 284                 return ERROR_OP;
 285             }
 286             str++;
 287             VERBOSE (DEBUG, fprintf (stdout, "stop processing brace\n"));
 288             continue;
 289         }
 290
 291         /* check for open bracket */
 292
 293         if (*str == '(') {
 294             VERBOSE (DEBUG, fprintf (stdout, "start processing bracket\n"));
 295             if (root) {
 296                 do {
 297                     found = 0;
 298                     new = parser (str + 1, &str, 0);
 299                     if ((new == NULL) || ((new != ERROR_OP) && (new->prio == 9))) {
 300                         delelement (new);
 301                         new = ERROR_OP;
 302                     }
 303                     if ((new == NULL) || (new == ERROR_OP)) {
 304                         delelement (root);
 305                         return ERROR_OP;
 306                     }
 307                     for (i = 0; i < root->nbops; i++) {
 308                         if (root->ops[i] == NULL) {
 309                             root->ops[i] = new;
 310                             found = 1;
 311                             break;
 312                         }
 313                     }
 314                     if (!found) {
 315                         delelement (new);
 316                         delelement (root);
 317                         return ERROR_OP;
 318                     }
 319                 } while (*str == ',');
 320             } else {
 321                 root = newelement (Val, 1, 5);
 322                 new = parser (str + 1, &str, 0);
 323                 if ((new == NULL) || ((new != ERROR_OP) && (new->prio == 9))) {
 324                     delelement (new);
 325                     new = ERROR_OP;
 326                 }
 327                 if ((new == NULL) || (new == ERROR_OP) || (*str == ',')) {
 328                     delelement (new);
 329                     delelement (root);
 330                     return ERROR_OP;
 331                 }
 332                 root->ops[0] = new;
 333             }
 334             if (*str != ')') {
 335                 delelement (root);
 336                 return ERROR_OP;
 337             }
 338             str++;
 339             VERBOSE (DEBUG, fprintf (stdout, "stop processing bracket\n"));
 340             continue;
 341         }
 342
 343         /* check for closing bracket, closing brace or koma */
 344
 345         if ((*str == ')') || (*str == '}') || (*str == ',')) {
 346             if (prio == -9) {
 347                 delelement (root);
 348                 return ERROR_OP;
 349             }
 350             if (next != NULL) {
 351                 *next = str;
 352             }
 353             return root;
 354         }
 355
 356         /* look for operators */
 357
 358         for (i = 0; i < NB_OPERATORS; i++) {
 359             keyword_t *operator = operators + i;
 360             if (codecmp (operator->keyword, str) == 0) {
 361                 VERBOSE (DEBUG, fprintf (stdout, "start processing operator\n"));
 362                 if (root) {
 363                     if ((prio) && (prio > operator->prio)) {
 364                         VERBOSE (DEBUG, fprintf (stdout, "stop because operator priority\n"));
 365                         *next = str;
 366                         return root;
 367                     }
 368                     str += operator->offset;
 369                     VERBOSE (INFO, fprintf (stdout, "Oper: %d\n", operator->func));
 370                     if (subparser (&root, &str, operator->func, operator->nbops, operator->prio) == ERROR_OP) {
 371                         delelement (root);
 372                         return ERROR_OP;
 373                     }
 374                 } else if (*str == '-') {
 375                     root = newelement (Sig, 1, 9);
 376                 } else {
 377                     return ERROR_OP;
 378                 }
 379                 found = 1;
 380                 VERBOSE (DEBUG, fprintf (stdout, "stop processing operator\n"));
 381                 break;
 382             }
 383         }
 384         if (found) {
 385             continue;
 386         }
 387
 388         /* look for functions */
 389
 390         for (i = 0; i < NB_FUNCTIONS; i++) {
 391             keyword_t *function = functions + i;
 392             if (codecmp (function->keyword, str) == 0) {
 393                 VERBOSE (DEBUG, fprintf (stdout, "start processing function\n"));
 394                 if (root == NULL) {
 395                     VERBOSE (INFO, fprintf (stdout, "Func: %d\n", function->func));
 396                     root = newelement (function->func, function->nbops, function->prio);
 397                 } else {
 398                     delelement (root);
 399                     return ERROR_OP;
 400                 }
 401                 str += function->offset;
 402                 found = 1;
 403                 VERBOSE (DEBUG, fprintf (stdout, "stop processing function\n"));
 404                 break;
 405             }
 406         }
 407         if (found) {
 408             continue;
 409         }
 410
 411         /* look for constant */
 412
 413         for (i = 0; i < NB_CONSTANTS; i++) {
 414             keyword_t *constant = constants + i;
 415             if (codecmp (constant->keyword, str) == 0) {
 416                 VERBOSE (DEBUG, fprintf (stdout, "start processing constant\n"));
 417                 if (root == NULL) {
 418                     VERBOSE (INFO, fprintf (stdout, "Const: %d\n", constant->func));
 419                     root = newelement (constant->func, constant->nbops, constant->prio);
 420                 } else {
 421                     delelement (root);
 422                     return ERROR_OP;
 423                 }
 424                 str += constant->offset;
 425                 found = 1;
 426                 VERBOSE (DEBUG, fprintf (stdout, "stop processing constant\n"));
 427                 break;
 428             }
 429         }
 430         if (found) {
 431             continue;
 432         }
 433
 434         /* look for number */
 435
 436         if (((*str >= '0') && (*str <= '9')) ||
 437             (*str == '.') || (*str == '+') || (*str == '-')) {
 438             VERBOSE (DEBUG, fprintf (stdout, "start processing value\n"));
 439             char *pt;
 440             double value = strtod (str, &pt);
 441             VERBOSE (INFO, fprintf (stdout, "Value: %f\n", value));
 442             if (str != pt) {
 443                 if ((root == NULL) || (root->prio == 6)) {
 444                     new = newelement (Val, 1, 5);
 445                     new->value = value;
 446                     if (root == NULL) {
 447                         root = new;
 448                     } else {
 449                         for (i = 0; i < root->nbops; i++) {
 450                             if (root->ops[i] == NULL) {
 451                                 root->ops[i] = new;
 452                                 found = 1;
 453                                 break;
 454                             }
 455                         }
 456                         if (!found) {
 457                             delelement (new);
 458                             delelement (root);
 459                             return ERROR_OP;
 460                         }
 461                     }
 462                     str = pt;
 463                 } else if ((*str == '+') || (*str == '-')) {
 464                     if ((prio) && (prio > 1)) {
 465                         VERBOSE (DEBUG, fprintf (stdout, "stop because operator priority\n"));
 466                         *next = str;
 467                         return root;
 468                     }
 469                     if (subparser (&root, &str, Add, 2, 1) == ERROR_OP) {
 470                         delelement (root);
 471                         return ERROR_OP;
 472                     }
 473                 } else {
 474                     delelement (root);
 475                     return ERROR_OP;
 476                 }
 477                 found = 1;
 478             }
 479             VERBOSE (DEBUG, fprintf (stdout, "stop processing value\n"));
 480         }
 481
 482         /* error */
 483
 484         if (!found) {
 485             delelement (root);
 486             return ERROR_OP;
 487         }
 488
 489     }
 490
 491     if (next != NULL) {
 492         *next = str;
 493     }
 494
 495     /* save string */
 496     if (root != NULL) {
 497         root->string = string;
 498     }
 499
 500     return root;
 501 }
 502
 503 /* print element tree */
 504
 505 void print_element (element_t *root, int level)
 506 {
 507     char *func = NULL;
 508     int i;
 509
 510     if ((root == NULL) || (root == ERROR_OP)) {
 511         return;
 512     }
 513
 514     for (i = 0; i < level; i++) {
 515         fprintf (stdout, " ");
 516     }
 517
 518     switch (root->func) {
 519     case Val: func = "Value"; break;
 520     case Sig: func = "Sign"; break;
 521     case Add: func = "Addition"; break;
 522     case Sub: func = "Subtraction"; break;
 523     case Mul: func = "Multiplication"; break;
 524     case Div: func = "Division"; break;
 525     case Mod: func = "Modulo"; break;
 526     case Pow: func = "Power"; break;
 527     case Sqr: func = "Square Root"; break;
 528     case Cos: func = "Cosine"; break;
 529     case Sin: func = "Sine"; break;
 530     case Tan: func = "Tangent"; break;
 531     case Acos: func = "Arc Cosine"; break;
 532     case Asin: func = "Arc Sine"; break;
 533     case Atan: func = "Arc Tangent"; break;
 534     case Ln: func = "Logarithm (natural)"; break;
 535     case Log: func = "Logarithm (10 base)"; break;
 536     case Exp: func = "Exponantial"; break;
 537     case Erfc: func = "Complementary Error Function"; break;
 538     case Erf: func = "Error Function"; break;
 539     case Abs: func = "Absolute value"; break;
 540     case Ceil: func = "Ceil value"; break;
 541     case Floor: func = "Floor value"; break;
 542     case Store: func = "Store"; break;
 543     case Recall: func = "Recall"; break;
 544     case Inc: func = "Increase"; break;
 545     case Dec: func = "Decrease"; break;
 546     case Disp: func = "Display"; break;
 547     case Mem: func = "Memory"; break;
 548     case Clear: func = "Clear"; break;
 549     case Quit: func = "Quit"; break;
 550     case Help: func = "Help"; break;
 551     case Ans: func = "Ans"; break;
 552     case Pi: func = "Pi"; break;
 553     case E: func = "E"; break;
 554     case Equal: func = "Equal"; break;
 555     case Diff: func = "Different"; break;
 556     case Ge: func = "Greater or equal"; break;
 557     case Le: func = "Lesser or equal"; break;
 558     case Gt: func = "Greater"; break;
 559     case Lt: func = "Lesser"; break;
 560     case And: func = "And"; break;
 561     case Or: func = "Or"; break;
 562     case Not: func = "Not"; break;
 563     case Cond: func = "Condition"; break;
 564     case While: func = "While"; break;
 565     case Code: func = "Code"; break;
 566     case Print: func = "Print"; break;
 567     case Prog: func = "Program"; break;
 568     case Arg: func = "Argument"; break;
 569     case Call: func = "Call"; break;
 570     case List: func = "List"; break;
 571     case Edit: func = "Edit"; break;
 572     case Del: func = "Del"; break;
 573     case Get: func = "Get"; break;
 574     case Length: func = "Length"; break;
 575     case Pop: func = "Pop"; break;
 576     case Push: func = "Push"; break;
 577     case Put: func = "Put"; break;
 578     case Set: func = "Set"; break;
 579     case Show: func = "Show"; break;
 580     }
 581
 582     fprintf (stdout, "Function: %s\n", func);
 583
 584     if ((root->func == Val) && (root->ops[0] == NULL)) {
 585         for (i = 0; i < level; i++) {
 586             fprintf (stdout, " ");
 587         }
 588         fprintf (stdout, "value: %f\n", root->value);
 589     } else {
 590         for (i = 0; i < root->nbops; i++) {
 591             print_element (root->ops[i], level + 1);
 592         }
 593     }
 594 }
 595
 596 /* storage functions */
 597
 598 void memory (int nb)
 599 {
 600     int i, l;
 601     double *tmp = NULL;
 602     if (nb != storage_size) {
 603         l = (nb < storage_size) ? nb : storage_size;
 604         tmp = (double *) callocordie (nb, sizeof (double));
 605         for (i = 0; i < l; i++) {
 606             tmp[i] = storage[i];
 607         }
 608         if (storage != NULL) {
 609             free (storage);
 610         }
 611         storage = tmp;
 612         storage_size = nb;
 613     }
 614 }
 615
 616 double store (int index, double value)
 617 {
 618     if (storage_size == -1) {
 619         memory (DEFAULT_STORAGE_SIZE);
 620     }
 621     if ((index > 0) && (index <= storage_size)) {
 622         storage[index - 1] = value;
 623     } else {
 624         VERBOSE (WARNING, fprintf (stdout, "invalid index (%d) [%d, %d]\n", index, (storage_size) ? 1 : 0, storage_size));
 625     }
 626     return value;
 627 }
 628
 629 double recall (int index)
 630 {
 631     if (storage_size == -1) {
 632         memory (DEFAULT_STORAGE_SIZE);
 633     }
 634     if ((index > 0) && (index <= storage_size)) {
 635         return storage[index - 1];
 636     } else {
 637         VERBOSE (WARNING, fprintf (stdout, "invalid index (%d) [%d, %d]\n", index, (storage_size) ? 1 : 0, storage_size));
 638     }
 639     return 0;
 640 }
 641
 642 double increase (int index)
 643 {
 644     if (storage_size == -1) {
 645         memory (DEFAULT_STORAGE_SIZE);
 646     }
 647     if ((index > 0) && (index <= storage_size)) {
 648         return storage[index - 1]++;
 649     } else {
 650         VERBOSE (WARNING, fprintf (stdout, "invalid index (%d) [%d, %d]\n", index, (storage_size) ? 1 : 0, storage_size));
 651     }
 652     return 0;
 653 }
 654
 655 double decrease (int index)
 656 {
 657     if (storage_size == -1) {
 658         memory (DEFAULT_STORAGE_SIZE);
 659     }
 660     if ((index > 0) && (index <= storage_size)) {
 661         return storage[index - 1]--;
 662     } else {
 663         VERBOSE (WARNING, fprintf (stdout, "invalid index (%d) [%d, %d]\n", index, (storage_size) ? 1 : 0, storage_size));
 664     }
 665     return 0;
 666 }
 667
 668 void display (void)
 669 {
 670     int i;
 671     if (storage_size == -1) {
 672         memory (DEFAULT_STORAGE_SIZE);
 673     }
 674     fprintf (stdout, "storage:");
 675     for (i = 0; i < storage_size; i++) {
 676         fprintf (stdout, " ");
 677         fprintf (stdout, minform, storage[i]);
 678     }
 679     fprintf (stdout, "\n");
 680 }
 681
 682 void clear ()
 683 {
 684     int i;
 685     for (i = 0; i < storage_size; i++) {
 686         storage[i] = 0;
 687     }
 688 }
 689
 690 /* While do function */
 691
 692 double while_do (element_t *cond, element_t *action)
 693 {
 694     double ret = 0;
 695     element_t *temp = NULL;
 696
 697     VERBOSE (DEBUG, fprintf (stdout, "starting while loop\n"));
 698     while (1) {
 699         VERBOSE (DEBUG, fprintf (stdout, "loop...\n"));
 700
 701         temp = dupelement (cond);
 702         double test = evaluate_element (temp, 0);
 703         delelement (temp);
 704         if (!test) {
 705             break;
 706         }
 707         if (action) {
 708             temp = dupelement (action);
 709             ret = evaluate_element (temp, 0);
 710             delelement (temp);
 711         }
 712     }
 713
 714     VERBOSE (DEBUG, fprintf (stdout, "ending while loop\n"));
 715
 716     return ret;
 717 }
 718
 719 /* program function */
 720
 721 double execute_code (element_t **prog, int nbcalls)
 722 {
 723     double ret = 0;
 724     int i;
 725     for (i = 0; i < nbcalls; i++) {
 726         ret = evaluate_element (prog[i], 0);
 727     }
 728     return ret;
 729 }
 730
 731 /* print function */
 732
 733 void set_format (char *prompt, int precision)
 734 {
 735     char buffer[128] = {0};
 736     free_format ();
 737     sprintf (buffer, "%s%%.%dg\n", prompt, precision);
 738     format = strdup (buffer);
 739     sprintf (buffer, "%%.%dg", precision);
 740     minform = strdup (buffer);
 741 }
 742
 743 void free_format ()
 744 {
 745     if (format) {
 746         free (format);
 747         format = NULL;
 748     }
 749     if (minform) {
 750         free (minform);
 751         minform = NULL;
 752     }
 753 }
 754
 755 double print (double value)
 756 {
 757     fprintf (stdout, format ? format : DEFAULT_FORMAT, value);
 758     fflush (stdout);
 759     return value;
 760 }
 761
 762 /* quit function */
 763
 764 void quit (void)
 765 {
 766     fprintf (stdout, "bye\n");
 767     exit (0);
 768 }
 769
 770 /* program function */
 771
 772 void prog (int id, element_t *root)
 773 {
 774     int i, n = -1;
 775
 776     if (programs == NULL) {
 777
 778         /* initial memory allocation */
 779         programs = (workspace_t *) callocordie (1, sizeof (workspace_t));
 780         nb_programs = 1;
 781         n = 0;
 782
 783     } else {
 784
 785         /* look for existing program */
 786         for (i = 0; i < nb_programs; i++) {
 787             if ((programs + i)->id == id) {
 788                 n = i;
 789                 break;
 790             }
 791         }
 792         if (n == -1) {
 793
 794             /* new program */
 795             n = nb_programs++;
 796             workspace_t *tmp = (workspace_t *) callocordie (nb_programs, sizeof (workspace_t));
 797             memcpy (tmp, programs, (nb_programs - 1) * sizeof (workspace_t));
 798             free (programs);
 799             programs = tmp;
 800         } else {
 801
 802             /* clean old program */
 803             if ((programs + n)->storage) {
 804                 free ((programs + n)->storage);
 805             }
 806             if ((programs + n)->stack) {
 807                 free ((programs + n)->stack);
 808             }
 809             if ((programs + n)->root) {
 810                 delelement ((programs + n)->root);
 811             }
 812             if ((programs + n)->string) {
 813                 free ((programs + n)->string);
 814                 (programs + n)->string = NULL;
 815             }
 816         }
 817     }
 818
 819     /* set program */
 820     (programs + n)->id = id;
 821     (programs + n)->answer = 0;
 822     (programs + n)->storage = NULL;
 823     (programs + n)->storage_size = 0;
 824     (programs + n)->stack = NULL;
 825     (programs + n)->stack_size = 0;
 826     (programs + n)->root = dupelement (root);
 827 }
 828
 829 double arg (int id)
 830 {
 831     double ret = 0;
 832     if ((id <= 0) || (id > argument_size)) {
 833         VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", id, argument_size));
 834     } else {
 835         ret = argument[id - 1];
 836     }
 837     return ret;
 838 }
 839
 840 double call (int id, int nbargs, element_t **args)
 841 {
 842     workspace_t tmp = {0};
 843     int i, l, n = -1;
 844     double ret = 0;
 845
 846     if (programs) {
 847
 848         /* look for program */
 849         for (i = 0; i < nb_programs; i++) {
 850             if ((programs + i)->id == id) {
 851                 n = i;
 852                 break;
 853             }
 854         }
 855     }
 856     if (n == -1) {
 857         VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
 858         return 0;
 859     }
 860
 861     /* store context */
 862     tmp.answer = answer;
 863     tmp.argument = argument;
 864     tmp.argument_size = argument_size;
 865     tmp.storage = storage;
 866     tmp.storage_size = storage_size;
 867     tmp.stack = stack;
 868     tmp.stack_size = stack_size;
 869
 870     /* change context */
 871     answer = 0;
 872     storage = (programs + n)->storage;
 873     storage_size = (programs + n)->storage_size;
 874     argument = NULL;
 875     argument_size = 0;
 876     stack = (programs + n)->stack;
 877     stack_size = (programs + n)->stack_size;
 878     if (nbargs > 0) {
 879         argument = (double *) callocordie (nbargs, sizeof (double));
 880         for (i = 0, l = 0; i < nbargs; l++) {
 881             if (args[l]) {
 882                 argument[i++] = evaluate_element (args[l], 0);
 883             }
 884         }
 885         argument_size = nbargs;
 886     }
 887
 888     /* evaluate program */
 889     element_t *elements = dupelement ((programs + n)->root);
 890     ret = evaluate_element (elements, 0);
 891     delelement (elements);
 892     (programs + n)->answer = answer;
 893     (programs + n)->storage = storage;
 894     (programs + n)->storage_size = storage_size;
 895     if (argument) {
 896         free (argument);
 897     }
 898     (programs + n)->stack = stack;
 899     (programs + n)->stack_size = stack_size;
 900
 901     /* restore context */
 902     answer = tmp.answer;
 903     storage = tmp.storage;
 904     storage_size = tmp.storage_size;
 905     argument = tmp.argument;
 906     argument_size = tmp.argument_size;
 907     stack = tmp.stack;
 908     stack_size = tmp.stack_size;
 909
 910     return ret;
 911 }
 912
 913 void list ()
 914 {
 915     int i;
 916     fprintf (stdout, "programs:");
 917     for (i = 0; i < nb_programs; i++) {
 918         fprintf (stdout, " %d", (programs + i)->id);
 919     }
 920     fprintf (stdout, "\n");
 921 }
 922
 923 void edit (int id)
 924 {
 925     int i, n = -1;
 926
 927     if (programs) {
 928
 929         /* look for program */
 930         for (i = 0; i < nb_programs; i++) {
 931             if ((programs + i)->id == id) {
 932                 n = i;
 933                 break;
 934             }
 935         }
 936     }
 937     if (n == -1) {
 938         VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
 939         return;
 940     }
 941
 942     /* set string program */
 943     fprintf (stdout, "edit: %s\n", (programs + n)->string);
 944 }
 945
 946 void savestring (int id, char *string)
 947 {
 948     int i, n = -1;
 949
 950     if (programs) {
 951
 952         /* look for program */
 953         for (i = 0; i < nb_programs; i++) {
 954             if ((programs + i)->id == id) {
 955                 n = i;
 956                 break;
 957             }
 958         }
 959     }
 960
 961     /* unnecesary code */
 962     //if (n == -1) {
 963     //    VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
 964     //    return;
 965     //}
 966     //if ((programs + n)->string) {
 967     //    free ((programs + n)->string);
 968     //}
 969
 970     (programs + n)->string = strdup (string);
 971 }
 972
 973 void del (int id)
 974 {
 975     int i, j, n = -1;
 976
 977     if (programs) {
 978
 979         /* look for program */
 980         for (i = 0; i < nb_programs; i++) {
 981             if ((programs + i)->id == id) {
 982                 n = i;
 983                 break;
 984             }
 985         }
 986     }
 987     if (n == -1) {
 988         VERBOSE (WARNING, fprintf (stdout, "error unknown program (%d)\n", id));
 989         return;
 990     }
 991
 992     /* clean program */
 993     if ((programs + n)->storage) {
 994         free ((programs + n)->storage);
 995     }
 996     if ((programs + n)->stack) {
 997         free ((programs + n)->stack);
 998     }
 999     if ((programs + n)->root) {
1000         delelement ((programs + n)->root);
1001     }
1002     if ((programs + n)->string) {
1003         free ((programs + n)->string);
1004     }
1005
1006     /* remove entry */
1007     workspace_t *tmp = (workspace_t *) callocordie (nb_programs - 1, sizeof (workspace_t));
1008     for (i = 0, j = 0; i < nb_programs; i++) {
1009         if (i != n) {
1010             memcpy (tmp + j, programs + i, sizeof (workspace_t));
1011             j++;
1012         }
1013     }
1014     free (programs);
1015     programs = tmp;
1016     nb_programs--;
1017 }
1018
1019 /* stack management */
1020
1021 double get (int n)
1022 {
1023     double ret = 0;
1024     if ((n <= 0) || (n > stack_size)) {
1025         VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", n, stack_size));
1026     } else {
1027         ret = stack[n - 1];
1028     }
1029     return ret;
1030 }
1031
1032 double length ()
1033 {
1034     return stack_size;
1035 }
1036
1037 double pop ()
1038 {
1039     double ret = 0;
1040     if (stack_size > 0) {
1041         ret = stack[--stack_size];
1042         double *tmp = (double *) callocordie (stack_size, sizeof (double));
1043         memcpy (tmp, stack, stack_size * sizeof (double));
1044         free (stack);
1045         stack = tmp;
1046     } else {
1047         VERBOSE (WARNING, fprintf (stdout, "error stack empty\n"));
1048     }
1049     return ret;
1050 }
1051
1052 double push (double val)
1053 {
1054     double *tmp = (double *) callocordie (stack_size + 1, sizeof (double));
1055     memcpy (tmp, stack, stack_size * sizeof (double));
1056     if (stack) {
1057         free (stack);
1058     }
1059     stack = tmp;
1060     stack[stack_size++] = val;
1061     return val;
1062 }
1063
1064 double put (int n, double val)
1065 {
1066     if (n <= 0) {
1067         VERBOSE (WARNING, fprintf (stdout, "error out of bound (%d/%d)\n", n, stack_size));
1068         return 0;
1069     }
1070     if (n > stack_size) {
1071         double *tmp = (double *) callocordie (n, sizeof (double));
1072         memcpy (tmp, stack, stack_size * sizeof (double));
1073         free (stack);
1074         stack = tmp;
1075         stack_size = n;
1076     }
1077     stack[n - 1] = val;
1078     return val;
1079 }
1080
1081 double set (int nbops, element_t **ops)
1082 {
1083     int i;
1084     if (stack) {
1085         free (stack);
1086     }
1087     stack = NULL;
1088     stack_size = 0;
1089     if (nbops != 0) {
1090          stack = (double *) callocordie (nbops, sizeof (double));
1091          for (i = 0; i < nbops; i++) {
1092              stack[i] = evaluate_element (ops[i], 0);
1093          }
1094          stack_size = nbops;
1095     }
1096     return stack_size;
1097 }
1098
1099 void show (void)
1100 {
1101     int i;
1102     fprintf (stdout, "stack:");
1103     for (i = 0; i < stack_size; i++) {
1104         fprintf (stdout, " ");
1105         fprintf (stdout, minform, stack[i]);
1106     }
1107     fprintf (stdout, "\n");
1108 }
1109
1110 /* help message */
1111
1112 void help (void)
1113 {
1114     fprintf (stdout, "calc is a simple calculator\n\n");
1115     fprintf (stdout, "arithmetic op.:");
1116     fprintf (stdout, " + - * / %% ^\n");
1117     fprintf (stdout, "comparison op.:");
1118     fprintf (stdout, " == != >= <= > <\n");
1119     fprintf (stdout, "logical op.:");
1120     fprintf (stdout, " & | !\n");
1121     fprintf (stdout, "mathematic func.:");
1122     fprintf (stdout, " exp ln log pow sqrt\n");
1123     fprintf (stdout, "trigonometric func.:");
1124     fprintf (stdout, " acos asin atan cos sin tan\n");
1125     fprintf (stdout, "error functions:");
1126     fprintf (stdout, " erf erfc\n");
1127     fprintf (stdout, "miscellaneous func.:");
1128     fprintf (stdout, " abs ceil floor\n");
1129     fprintf (stdout, "storage func.:");
1130     fprintf (stdout, " clear dec disp inc mem rcl sto\n");
1131     fprintf (stdout, "control flow prim.:");
1132     fprintf (stdout, " cond print while {} ;\n");
1133     fprintf (stdout, "program management:");
1134     fprintf (stdout, " arg call del edit ls prog\n");
1135     fprintf (stdout, "stack management:");
1136     fprintf (stdout, " get len pop push put set show\n");
1137     fprintf (stdout, "control management:");
1138     fprintf (stdout, " help quit\n");
1139     fprintf (stdout, "constants:");
1140     fprintf (stdout, " ans e pi\n");
1141 }
1142
1143 /* evaluate element tree */
1144
1145 #define MASK_SUB 0x1
1146 #define MASK_DIV 0x2
1147
1148 double evaluate_element (element_t *root, char mask)
1149 {
1150     double op0 = 0, op1 = 0;
1151     char nextmask = mask;
1152     int i, nb;
1153
1154     if ((root == NULL) || (root == ERROR_OP)) {
1155         VERBOSE (WARNING, fprintf (stdout, "error while evaluating\n"));
1156         return 0;
1157     }
1158
1159     /* mask to manage sub operator sub and div */
1160     switch (root->func) {
1161     case Add:
1162         nextmask &= ~MASK_SUB;
1163         nextmask &= ~MASK_DIV;
1164         break;
1165     case Sub:
1166         nextmask |= MASK_SUB;
1167         nextmask &= ~MASK_DIV;
1168         break;
1169     case Mul:
1170         nextmask &= ~MASK_DIV;
1171         break;
1172     case Div:
1173         nextmask |= MASK_DIV;
1174         break;
1175     default:
1176         nextmask = mask;
1177     }
1178
1179     switch (root->func) {
1180     case Val:
1181     case Sig:
1182         op0 = (root->ops[0]) ? evaluate_element (root->ops[0], nextmask) : root->value;
1183         break;
1184     case Add:
1185     case Sub:
1186     case Mul:
1187     case Div:
1188     case Mod:
1189     case Pow:
1190     case Store:
1191     case Equal:
1192     case Diff:
1193     case Ge:
1194     case Le:
1195     case Gt:
1196     case Lt:
1197     case And:
1198     case Or:
1199         if (root->ops[1]) {
1200             op1 = evaluate_element (root->ops[1], nextmask);
1201         } else if (root->func != Store) {
1202             VERBOSE (WARNING, fprintf (stdout, "error while evaluating (op[1])\n"));
1203             return 0;
1204         }
1205         /* fallthrough */
1206     case Sqr:
1207     case Cos:
1208     case Sin:
1209     case Tan:
1210     case Acos:
1211     case Asin:
1212     case Atan:
1213     case Ln:
1214     case Log:
1215     case Exp:
1216     case Erfc:
1217     case Erf:
1218     case Abs:
1219     case Ceil:
1220     case Floor:
1221     case Recall:
1222     case Inc:
1223     case Dec:
1224     case Not:
1225     case Mem:
1226     case Cond:
1227     case Prog:
1228     case Arg:
1229     case Call:
1230     case Edit:
1231     case Del:
1232     case Get:
1233         if (root->ops[0]) {
1234             op0 = evaluate_element (root->ops[0], 0);
1235         } else {
1236             VERBOSE (WARNING, fprintf (stdout, "error while evaluating (op[0])\n"));
1237             return 0;
1238         }
1239         break;
1240     case Disp:
1241     case Clear:
1242     case Quit:
1243     case Help:
1244     case Ans:
1245     case Pi:
1246     case E:
1247     case Code:
1248     case List:
1249     case Length:
1250     case Pop:
1251     case Set:
1252     case Show:
1253         break;
1254     case While:
1255         if (root->ops[0] == NULL) {
1256             VERBOSE (WARNING, fprintf (stdout, "error while evaluating (op[0])\n"));
1257             return 0;
1258         }
1259         break;
1260     case Push:
1261     case Print:
1262         op0 = (root->ops[0]) ? evaluate_element (root->ops[0], 0) : answer;
1263         break;
1264     case Put:
1265         if (root->ops[0]) {
1266             op0 = evaluate_element (root->ops[0], 0);
1267         } else {
1268             VERBOSE (WARNING, fprintf (stdout, "error while evaluating (op[0])\n"));
1269             return 0;
1270         }
1271         op1 = (root->ops[1]) ? evaluate_element (root->ops[1], 0) : answer;
1272         break;
1273     }
1274
1275     switch (root->func) {
1276     case Val: return op0;
1277     case Sig: return -op0;
1278     case Add: return ((mask & MASK_SUB) == 0) ? op0 + op1 : op0 - op1;
1279     case Sub: return ((mask & MASK_SUB) == 0) ? op0 - op1 : op0 + op1;
1280     case Mul: return ((mask & MASK_DIV) == 0) ? op0 * op1 : op0 / op1;
1281     case Div: return ((mask & MASK_DIV) == 0) ? op0 / op1 : op0 * op1;
1282     case Mod: return fmod (op0, op1);
1283     case Pow: return pow (op0, op1);
1284     case Sqr: return sqrt (op0);
1285     case Cos: return cos (op0);
1286     case Sin: return sin (op0);
1287     case Tan: return tan (op0);
1288     case Acos: return acos (op0);
1289     case Asin: return asin (op0);
1290     case Atan: return atan (op0);
1291     case Ln: return log (op0);
1292     case Log: return log10 (op0);
1293     case Exp: return exp (op0);
1294     case Erfc: return erfc (op0);
1295     case Erf: return erf (op0);
1296     case Abs: return fabs (op0);
1297     case Ceil: return ceil (op0);
1298     case Floor: return floor (op0);
1299     case Store: return store ((int)op0, (op1) ? op1 : answer);
1300     case Recall: return recall ((int)op0);
1301     case Inc: return increase ((int)op0);
1302     case Dec: return decrease ((int)op0);
1303     case Disp: display (); break;
1304     case Mem: memory ((int)op0); break;
1305     case Clear: clear (); break;
1306     case Quit: quit (); break;
1307     case Help: help (); break;
1308     case Ans: return answer;
1309     case Pi: return M_PI;
1310     case E: return M_E;
1311     case Equal: return op0 == op1;
1312     case Diff: return op0 != op1;
1313     case Ge: return op0 >= op1;
1314     case Le: return op0 <= op1;
1315     case Gt: return op0 > op1;
1316     case Lt: return op0 < op1;
1317     case And: return (op0 != 0) && (op1 != 0);
1318     case Or: return (op0 != 0) || (op1 != 0);
1319     case Not: return (op0 == 0);
1320     case Cond:
1321         if ((op0) && (root->ops[1])) {
1322             return evaluate_element (root->ops[1], 0);
1323         } else if ((!op0) && (root->ops[2])) {
1324             return evaluate_element (root->ops[2], 0);
1325         } else {
1326             return 0;
1327         }
1328     case While: return while_do (root->ops[0], root->ops[1]);
1329     case Code: return execute_code (root->ops, root->nbops);
1330     case Print: return print (op0);
1331     case Prog:
1332         prog ((int)op0, root->ops[1]);
1333         savestring ((int)op0, root->string);
1334         break;
1335     case Arg: return arg ((int)op0);
1336     case Call:
1337         for (i = 1, nb =0; i < root->nbops; i++) {
1338             if (root->ops[i]) {
1339                 nb++;
1340             }
1341         }
1342         return call ((int)op0, nb, root->ops + 1);
1343     case List: list (); break;
1344     case Edit: edit ((int)op0); break;
1345     case Del: del ((int)op0); break;
1346     case Get: return get ((int)op0);
1347     case Length: return length ();
1348     case Pop: return pop ();
1349     case Push: return push (op0);
1350     case Put: return put ((int)op0, op1);
1351     case Set:
1352         for (i = 0, nb =0; i < root->nbops; i++) {
1353             if (root->ops[i]) {
1354                 nb++;
1355             }
1356         }
1357         return set (nb, root->ops);
1358     case Show: show (); break;
1359     }
1360
1361     return 0;
1362 }
1363
1364 char **generate_completion_list ()
1365 {
1366     int i, j, l = 0;
1367     char **list = (char **) callocordie (NB_OPERATORS + NB_FUNCTIONS + NB_CONSTANTS + NB_SYMBOLS + 1, sizeof (char *));
1368
1369     for (i = 0; i < NB_OPERATORS; i++) {
1370         list[l] = strdup ((operators + i)->keyword);
1371         for (j = 0; j < (int)strlen (list[l]); j++) {
1372             if (list[i][j] == '\t') {
1373                 list[i][j] = '\0';
1374             }
1375         }
1376         if (list[l] != NULL) {
1377             l++;
1378         }
1379     }
1380
1381     for (i = 0; i < NB_FUNCTIONS; i++) {
1382         list[l] = strdup ((functions + i)->keyword);
1383         if (list[l] != NULL) {
1384             l++;
1385         }
1386     }
1387
1388     for (i = 0; i < NB_CONSTANTS; i++) {
1389         list[l] = strdup ((constants + i)->keyword);
1390         if (list[l] != NULL) {
1391             l++;
1392         }
1393     }
1394
1395     for (i = 0; i < NB_SYMBOLS; i++) {
1396         list[l] = strdup (symbols[i]);
1397         if (list[l] != NULL) {
1398             l++;
1399         }
1400     }
1401
1402     return (list);
1403 }
1404
1405 void free_completion_list (char **list)
1406 {
1407     int i;
1408
1409     if (list) {
1410         for (i = 0; i < NB_OPERATORS + NB_FUNCTIONS + NB_CONSTANTS + NB_SYMBOLS + 1; i++) {
1411             if (list[i] != NULL) {
1412                 free (list[i]);
1413             }
1414         }
1415         free (list);
1416     }
1417 }
1418
1419
1420 /* vim: set ts=4 sw=4 et: */