Logo Search packages:      
Sourcecode: gretl version File versions

gensyntax.c

/* 
 *  gretl -- Gnu Regression, Econometrics and Time-series Library
 *  Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
 * 
 *  This program is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 * 
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 * 
 *  You should have received a copy of the GNU General Public License
 *  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 * 
 */

/* parser module for 'genr' and related commands */

#include "genparse.h"

#if GENDEBUG
# define SDEBUG 1
# define MDEBUG 1
#else
# define SDEBUG 0
# define MDEBUG 0
#endif

#define set_transpose(n) (n->flags |= TRANSP_NODE)

static NODE *powterm (parser *p);

#if SDEBUG
static void notify (const char *s, NODE *t, parser *p)
{
    fprintf(stderr, "%-8s: returning node at %p, err = %d\n", 
          s, (void *) t, p->err);
}
#endif

static NODE *newempty (int t)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newempty: allocated node at %p\n", (void *) n);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.idnum = 0;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

static NODE *newref (parser *p, int t)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newref: allocated node at %p (type %d)\n", 
          (void *) n, t);
#endif

    if (n != NULL) {
      if (t == USERIES) {
          n->vnum = p->idnum;
          n->t = VEC;
          n->v.xvec = (*p->Z)[n->vnum];
      } else {
          n->t = t;
          if (t == USCALAR || t == UMAT || t == UOBJ || t == LIST) {
            n->v.str = p->idstr;
          } else {
            n->v.idnum = p->idnum;
          }
          n->vnum = NO_VNUM;
      }
      n->flags = 0;
    }

    return n;
}

static NODE *newstr (parser *p, int t)
{  
    NODE *n;

    if (p->idstr == NULL) {
      fprintf(stderr, "newstr: input is NULL\n");
      return NULL;
    }

    n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newstr: allocated node at %p (s = '%s')\n", 
          (void *) n, p->idstr);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.str = p->idstr;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

/* node storing a floating point value */

NODE *newdbl (double x)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newdbl: allocated node at %p (x = %g)\n", 
          (void *) n, x);
#endif

    if (n != NULL) {
      n->t = NUM;
      n->v.xval = x;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

/* node for unary operator, or single-argument function */

static NODE *newb1 (int t, NODE *b)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newb1:  allocated node at %p (type = %d)\n", 
          (void *) n, t);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.b1.b = b;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

/* node for binary operator or two-argument function */

static NODE *newb2 (int t, NODE *l, NODE *r)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newb2:  allocated node at %p (type = %d)\n", 
          (void *) n, t);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.b2.l = l;
      n->v.b2.r = r;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

/* node for ternary operator */

static NODE *newb3 (int t, NODE *l, NODE *m, NODE *r)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newb3:  allocated node at %p (type = %d)\n", 
          (void *) n, t);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.b3.l = l;
      n->v.b3.m = m;
      n->v.b3.r = r;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

/* node for unknown number of subnodes */

static NODE *newbn (int t)
{  
    NODE *n = malloc(sizeof *n);

#if MDEBUG
    fprintf(stderr, "newbn:  allocated node at %p (type = %d)\n", 
          (void *) n, t);
#endif

    if (n != NULL) {
      n->t = t;
      n->v.bn.n_nodes = 0;
      n->v.bn.n = NULL;
      n->flags = 0;
      n->vnum = NO_VNUM;
    }

    return n;
}

static int push_bn_node (NODE *t, NODE *n)
{
    NODE **nn;
    int k = t->v.bn.n_nodes;

    nn = realloc(t->v.bn.n, (k + 1) * sizeof *nn);
    if (nn == NULL) {
      return E_ALLOC;
    }

    t->v.bn.n = nn;
    t->v.bn.n[k] = n;
    t->v.bn.n_nodes += 1;

#if SDEBUG
    fprintf(stderr, "push_bn_node: n_nodes now = %d, "
          "added node of type %d (vnum = %d)\n", 
          t->v.bn.n_nodes, n->t, n->vnum);
#endif

    return 0;
}

static void expected_symbol_error (int c, parser *p)
{
    const char *found = getsymb(p->sym, p);

    parser_print_input(p);
    pprintf(p->prn, _("Expected '%c' but found '%s'\n"), c, 
          found);
    if (found != NULL) {
      if (!strcmp(found, "&")) {
          pputs(p->prn, "(for logical AND, please use \"&&\")\n");
      } else if (!strcmp(found, "|")) {
          pputs(p->prn, "(for logical OR, please use \"||\")\n");
      }
    }   
    p->err = 1;
}

static void unmatched_symbol_error (int c, parser *p)
{
    parser_print_input(p);
    pprintf(p->prn, _("Unmatched '%c'\n"), c);
    p->err = E_PARSE;
}

#define matrix_ref_node(p) (p->sym == UMAT || (p->sym == MVAR && \
                            model_data_matrix(p->idnum)))

/* try to recognize a unary ', indicating that we're taking
   the transpose of the preceding matrix */

static int unary_apost (parser *p) 
{
    if (p->ch == '\'') {
      /* peek at the next non-space character */
      int c = parser_next_char(p);

      if (isalpha(c) || c == '$' || c == '(') {
          /* next symbol is variable or expression: the
             apostrophe must be the binary operator, 
             B_TRMUL
          */
          return 0;
      } else {
          return 1;
      }
    } 

    return 0;
}

static NODE *base (parser *p, NODE *up)
{ 
    NODE *t = NULL;

    if (p->err) {
      return NULL;
    }

#if SDEBUG
    fprintf(stderr, "base(): on input sym = %d ('%s'), ch = '%c'\n", 
          p->sym, getsymb(p->sym, p), p->ch? p->ch : '0');
#endif

    switch (p->sym) {
    case NUM: 
      t = newdbl(p->xval);
      lex(p);
      break;
    case USCALAR: 
    case USERIES:
    case UMAT:
    case UOBJ:
    case CON: 
    case DVAR:
    case MVAR:
    case OBS:
    case LIST:
      t = newref(p, p->sym);
      if (matrix_ref_node(p) && unary_apost(p)) {
          set_transpose(t);
          parser_getc(p);
      }
      lex(p);
      break;
    case DUM:
      if (p->idnum == DUM_NULL) {
          t = newempty(EMPTY);
      } else {
          t = newref(p, p->sym);
      }
      lex(p);
      break;
    case B_SUB:
    case B_ADD:
    case B_RANGE:
    case P_DOT:
      lex(p);
      t = expr(p);
      break;
    case G_LPR: /* left paren '(' */
      lex(p);
      t = expr(p);
      if (p->sym == G_RPR) {
          if (up != NULL && up->t != LAG && unary_apost(p)) {
            set_transpose(up);
            parser_getc(p);
          } 
          lex(p);
      } else if (p->err == 0) {
          expected_symbol_error(')', p);
      }
      break;
    case G_LBR: /* left bracket '[' */
      if (up == NULL) {
          goto deferr;
      }
      if (up->t == OBS) {
          t = obs_node(p);
      }
      if (p->sym == G_RBR) {
          if (up->t == MSL || up->t == DMSL) {
            if (p->ch == '\'') {
                set_transpose(up);
                parser_getc(p);
            }
          }
          lex(p);
      } else if (p->err == 0) {
          expected_symbol_error(']', p);
      }
      break;
    default: 
    deferr:
      context_error(0, p);
      break;
    }

#if SDEBUG
    notify("base", t, p);
#endif    

    return t;
}

/* construct a node that contains a reference to a data series, based
   on the name of a list (already captured in p->idstr) and the name
   of a variable that is supposed to be in the list, which is separated
   from the listname by '.'.
*/

static NODE *listvar_node (parser *p)
{
    int *list = get_list_by_name(p->idstr);
    NODE *ret = NULL;
    char vname[VNAMELEN] = {0};
    int i, n, v, ok = 0;

    if (list == NULL) {
      p->err = E_UNKVAR;
      return NULL;
    }

    n = gretl_namechar_spn(p->point);
    if (n >= VNAMELEN) {
      /* too long -- can't be a valid varname */
      p->err = E_UNKVAR;
      return NULL;
    }

    for (i=0; i<n; i++) {
      parser_getc(p);
      vname[i] = p->ch;
    }

    for (i=1; i<=list[0]; i++) {
      v = list[i];
      if (!strcmp(vname, p->dinfo->varname[v])) {
          /* found the variable */
          free(p->idstr);
          p->idstr = NULL;
          p->idnum = v;
          ret = newref(p, USERIES);
          if (ret == NULL) {
            p->err = E_ALLOC;
          } else {
            ok = 1;
          }
          break;
      }
    }

    if (!ok && !p->err) {
      p->err = E_UNKVAR;
    }

    if (!p->err) {
      parser_getc(p);
      lex(p);
    }

    return ret;    
}

/* Grab a string argument.  Note: we have a mechanism in genlex.c for
   retrieving arguments that take the form of quoted string literals
   or names of string variables.  The special use of this function is
   to grab a literal string without requiring the user to wrap it in
   quotes; we use it only where we know the only acceptable argument
   is a string.  This function assumes that the argument in question
   is the last (or only) argument to a function: we look for a closing
   parenthesis and flag an error if we don't find one.
*/

static NODE *get_string_arg (parser *p)
{
    int wrapped = 0;

    while (p->ch == ' ') {
      parser_getc(p);
    }

    if (p->ch == '"') {
      wrapped = 1;
      parser_getc(p);
    }

    if (p->ch == ')') {
      /* allow empty arg string "()" */
      p->idstr = gretl_strdup("");
    } else {
      int i, paren = 1, quoted = wrapped;
      int close = -1, started = 0;
      const char *s = p->point;

      /* find length of string to closing paren */
      i = 0;
      while (*s) {
          if (!quoted && *s == ')') paren--;
          if (paren == 0) {
            close = i;
            break;
          }
          if (*s == '"') {
            quoted = !quoted;
          } else if (!quoted && *s == '(') {
            paren++;
          }
          s++;
          i++;
      }

      if (close < 0) {
          unmatched_symbol_error('(', p);
          return NULL;
      }

      for (i=0; i<=close; i++) {
          if (!started && !isspace(p->ch)) {
            p->idstr = gretl_strndup(p->point - 1, close - i + 1);
            started = 1;
          }
          parser_getc(p);
      }
    }

    if (p->idstr == NULL) {
      p->err = E_ALLOC;
      return NULL;
    }

    parser_getc(p);
    lex(p);

    tailstrip(p->idstr);

    if (wrapped) {
      int n = strlen(p->idstr);

      if (p->idstr[n-1] == '"') {
          p->idstr[n-1] = '\0';
      } else {
          unmatched_symbol_error('"', p);
      }
    }

#if SDEBUG
    fprintf(stderr, "get_string_arg: '%s'\n", p->idstr);
#endif

    return newstr(p, STR);
}

enum {
    BOTH_OPT = 1,
    RIGHT_OPT,
    RIGHT_STR
};

/* gather an unknown number of comma-separated arguments
   for a (possibly user-defined) function */

static void get_multi_args (NODE *t, parser *p)
{
    NODE *n;
    char cexp = 0;

#if SDEBUG
    fprintf(stderr, "get_multi_args, p->sym = %d\n", p->sym);
#endif    

    if (p->sym == G_LPR) {
      lex(p);
      while (p->ch != 0 && !p->err) {
          n = expr(p);
          if (p->err) {
            break;
          } else {
            p->err = push_bn_node(t, n);
          }
          if (p->sym == P_COM) {
            /* in case acceptance of plain strings was set,
               turn it off after the first arg */
            p->flags &= ~P_GETSTR;
            lex(p);
          } else if (p->sym == G_RPR) {
            break;
          }
      }
    } else {
      cexp = '(';
    }

    if (cexp == 0 && !p->err) {
      if (p->sym == G_RPR) {
          lex(p);
      } else {
          unmatched_symbol_error('(', p);
      }
    }
          
    if (cexp && p->err == 0) {
      expected_symbol_error(cexp, p);
    }
}

static void get_matrix_def (NODE *t, parser *p, int *sub)
{
    NODE *n;
    char cexp = 0;

#if SDEBUG
    fprintf(stderr, "get_matrix_def, p->sym = %d\n", p->sym);
#endif    

    if (p->sym == G_LCB) {
      lex(p);
      while (p->ch != 0 && !p->err) {
          n = expr(p);
          if (p->err) {
            break;
          } else {
            p->err = push_bn_node(t, n);
          }
          if (p->sym == P_COM) {
            lex(p);
          } else if (p->sym == P_SEMI) {
            n = newempty(EMPTY);
            p->err = push_bn_node(t, n);
            lex(p);
          } else if (p->sym == G_RCB) {
            if (p->ch == '\'') {
                set_transpose(t);
                parser_getc(p);
            } else if (p->ch == '[') {
                parser_ungetc(p);
                *sub = 1;
            }
            break;
          }
      }
    } else {
      cexp = '{';
    }

    if (cexp == 0) {
      if (p->sym == G_RCB) {
          lex(p);
      } else {
          unmatched_symbol_error('{', p);
      }
    }
          
    if (cexp && p->err == 0) {
      expected_symbol_error(cexp, p);
    }
}     

static void get_slice_parts (NODE *t, parser *p)
{
    char cexp = 0;

#if SDEBUG
    fprintf(stderr, "get_slice_parts, p->sym = %d\n", p->sym);
#endif  

    set_matrix_slice_on();

    if (p->sym == G_LBR) {
      lex(p);
      if (p->sym == P_COM) {
          /* empty row spec, OK */
          t->v.b2.l = newempty(EMPTY);
      } else {
          t->v.b2.l = expr(p);
      }
      if (p->sym == P_COL) {
          /* second part of colon-separated range */
          t->v.b2.l = newb2(SUBSL, t->v.b2.l, NULL);
          lex(p);
          if (p->sym == P_COM || p->sym == G_RBR) {
            /* reached end: second part implicitly empty */
            t->v.b2.l->v.b2.r = newempty(EMPTY);
          } else {
            t->v.b2.l->v.b2.r = expr(p);
          }
      }
      if (p->sym == G_RBR) {
          /* no comma, no second arg string: may be OK */
          t->v.b2.r = newempty(ABSENT);
          lex(p);
          set_matrix_slice_off();
          return;
      }
      if (p->sym == P_COM) {
          lex(p);
          if (p->sym == G_RBR) {
            /* empty column spec, OK */
            t->v.b2.r = newempty(EMPTY);
          } else {
            t->v.b2.r = expr(p);
          }
          if (p->sym == P_COL) {
            /* second part of colon-separated range */
            t->v.b2.r = newb2(SUBSL, t->v.b2.r, NULL);
            lex(p);
            if (p->sym == G_RBR) {
                /* reached end: second part implicitly empty */
                t->v.b2.r->v.b2.r = newempty(EMPTY);
            } else {
                t->v.b2.r->v.b2.r = expr(p);
            }
          }
          if (p->sym == G_RBR) {
            if (p->ch == '\'') {
                set_transpose(t); /* ?? */
                parser_getc(p);
            }
            lex(p);
          } else {
            cexp = ']';
          }
      } else {
          cexp = ',';
      }
    } else {
      cexp = '[';
    }
          
    if (cexp && p->err == 0) {
      expected_symbol_error(cexp, p);
    }

    set_matrix_slice_off();
}

/* get up to two comma-separated arguments 
   (possibly optional) */

static void get_args (NODE *t, parser *p, int opt)
{
    char cexp = 0;

#if SDEBUG
    fprintf(stderr, "get_args...\n");
#endif    

    if (p->sym == G_LPR) {
      lex(p);
      if (p->sym == G_RPR && opt == BOTH_OPT) {
          /* no args, but it's OK */
          t->v.b2.l = newempty(EMPTY);
          t->v.b2.r = newempty(EMPTY);
          lex(p);
          return;
      }
      t->v.b2.l = expr(p);
      if (p->sym == G_RPR && opt == RIGHT_OPT) {
          /* no second arg, but it's OK */
          t->v.b2.r = newempty(EMPTY);
          lex(p);
          return;
      }         
      if (p->sym == P_COM) {
          if (opt == RIGHT_STR) {
            /* the second arg must be a literal string */
            t->v.b2.r = get_string_arg(p);
          } else {
            lex(p);
            t->v.b2.r = expr(p);
            if (p->sym == G_RPR) {
                if (p->ch == '\'') {
                  set_transpose(t);
                  parser_getc(p);
                }
                lex(p);
            } else {
                cexp = ')';
            }
          }
      } else {
          cexp = ',';
      }
    } else {
      cexp = '(';
    }
          
    if (cexp && p->err == 0) {
      expected_symbol_error(cexp, p);
    }
}

static void get_ovar_ref (NODE *t, parser *p)
{
    if (p->ch != '.' || parser_charpos(p, '$') != 0) {
      p->err = E_PARSE;
      return;
    }

    p->idnum = 0;

    /* handle the '.' */
    lex(p);

    /* get the following '$' name */
    lex(p);

    if (p->idnum == 0) {
      p->err = E_PARSE;
    } else if (p->sym == DMSL || p->sym == DMSTR) {
      /* followed by '[' or '(' matrix subspec? */
      t->v.b2.r = powterm(p);
    } else {
      t->v.b2.r = newref(p, p->sym);
      lex(p);
    }
}

static NODE *powterm (parser *p)
{ 
    /* watch out for unary operators */
    int sym = p->sym == B_SUB ? U_NEG : 
      p->sym == B_ADD ? U_POS :
      p->sym;
    int opt = OPT_NONE;
    NODE *t;

    if (p->err) {
      return NULL;
    }

#if SDEBUG
    fprintf(stderr, "powterm: p->sym = %d, p->ch = '%c' (%d)\n",
          p->sym, p->ch? p->ch : '0', p->ch);
#endif

    if (sym == F_RUNIFORM || sym == F_RNORMAL) {
      opt = BOTH_OPT;
    } else if (sym == F_FDJAC || sym == F_BFGSMAX) {
      opt = RIGHT_STR;
    } else if (sym == F_DUMIFY) {
      opt = RIGHT_OPT;
    }

    if (unary_op(sym)) {
      if (p->ch == 0) {
          context_error(0, p);
          return NULL;
      }
        t = newb1(sym, NULL);
        if (t != NULL) {
            lex(p);
            t->v.b1.b = powterm(p);
        }
    } else if (func2_symb(sym)) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          lex(p);
          get_args(t, p, opt);
      }
    } else if (string0_func(sym)) {
      t = newb1(sym, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b1.b = newbn(FARGS);
          if (t != NULL) {
            p->flags |= P_GETSTR;
            get_multi_args(t->v.b1.b, p);
          }
      }
    } else if (sym == F_URCPVAL) {
      t = newb1(sym, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b1.b = newbn(FARGS);
          if (t != NULL) {
            get_multi_args(t->v.b1.b, p);
          }
      }     
    } else if (string_arg_func(sym)) {
      t = newb1(sym, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b1.b = get_string_arg(p);
      }     
    } else if (func1_symb(sym)) {
      t = newb1(sym, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b1.b = base(p, t);
      }
    } else if (sym == LAG || sym == OBS) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          t->v.b2.l = newref(p, USERIES); 
          lex(p);
          t->v.b2.r = base(p, t);
      }
    } else if (func2_symb(sym)) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          lex(p);
          get_args(t, p, opt);
      }
    } else if (sym == MSL || sym == DMSL) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          if (p->sym == MSL) {
            t->v.b2.l = newstr(p, STR);
          } else {
            t->v.b2.l = newref(p, MVAR);
          }
          t->v.b2.r = newb2(MSL2, NULL, NULL);
          if (t->v.b2.r != NULL) {
            lex(p);
            get_slice_parts(t->v.b2.r, p);
          }
      }
    } else if (sym == DMSTR) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          t->v.b2.l = newref(p, MVAR);
          lex(p);
          t->v.b2.r = get_string_arg(p);
      }
    } else if (sym == OVAR) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          t->v.b2.l = newstr(p, STR);
          get_ovar_ref(t, p);
      }
    } else if (sym == LISTVAR) {
      t = listvar_node(p);
      if (t != NULL && (p->sym == G_LPR || p->sym == G_LBR)) {
          /* list.series node may be "inflected" as lag or obs */
          p->sym = (p->sym == G_LPR)? LAG : OBS;
          t = newb2(p->sym, t, NULL);
          if (t != NULL) {
            parser_ungetc(p);
            lex(p);
            t->v.b2.r = base(p, t);
          }
      }
    } else if (sym == G_LPR) {
      /* dummy root for parenthesized expressions, to facilitate
         taking the transpose of matrix stuff, e.g. (A*B)' */
      t = newb1(EROOT, NULL);
      if (t != NULL) {
          t->v.b1.b = base(p, t);
      }
    } else if (sym == G_LCB) {
      /* explicit matrix definition, possibly followed by
         a "subslice" specification */
      int sub = 0;

      t = newbn(MDEF);
      if (t != NULL) {
          get_matrix_def(t, p, &sub);
          if (sub) {
            t = newb2(MSL, t, NULL);
            if (t != NULL) {
                t->v.b2.r = newb2(MSL2, NULL, NULL);
                if (t->v.b2.r != NULL) {
                  lex(p);
                  get_slice_parts(t->v.b2.r, p);
                }
            }           
          }
      }
    } else if (sym == UFUN) {
      t = newb2(sym, NULL, NULL);
      if (t != NULL) {
          t->v.b2.l = newstr(p, STR);
          lex(p);
          t->v.b2.r = newbn(FARGS);
          if (t != NULL) {
            get_multi_args(t->v.b2.r, p);
          }
      }
    } else if (funcn_symb(sym)) {
      t = newb1(sym, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b1.b = newbn(FARGS);
          if (t != NULL) {
            get_multi_args(t->v.b1.b, p);
          }
      }
    } else if (sym == STR || sym == VSTR) {
      t = newstr(p, sym);
      lex(p);
    } else {
      t = base(p, NULL);
    }

#if SDEBUG
    notify("powterm", t, p);
#endif

    return t;
}

static NODE *factor (parser *p)
{  
    int sym = p->sym == B_SUB ? U_NEG : 
      p->sym == B_ADD ? U_POS : 
      p->sym;
    NODE *t;

    if (p->err) {
      return NULL;
    }

    if (unary_op(sym)) {
      if (p->ch == 0) {
          context_error(0, p);
          return NULL;
      }
        t = newb1(sym, NULL);
        if (t != NULL) {
            lex(p);
            t->v.b1.b = factor(p);
        }
    } else {
      t = powterm(p);
      if (t != NULL) {
          if (p->sym == B_TRMUL && p->ch == 0) {
            /* can't really be TRMUL at end of input */
            set_transpose(t);
          } else {
            while (!p->err && (p->sym == B_POW || 
                           p->sym == B_DOTPOW ||
                           p->sym == B_TRMUL)) {
                t = newb2(p->sym, t, NULL);
                if (t != NULL) {
                  lex(p);
                  t->v.b2.r = powterm(p);
                }
            }
          }
      }
    }

#if SDEBUG
    notify("factor", t, p);
#endif

    return t;
}

static NODE *term (parser *p)
{  
    NODE *t;

    if (p->err || (t = factor(p)) == NULL) {
      return NULL;
    }

    while (!p->err && (p->sym == B_MUL || p->sym == B_DIV || 
                   p->sym == B_MOD || p->sym == B_DOTMULT || 
                   p->sym == B_DOTDIV || p->sym == B_KRON)) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = factor(p);
      }
    }

#if SDEBUG
    notify("term", t, p);
#endif

    return t;
}

static NODE *expr4 (parser *p)
{  
    NODE *t;

    if (p->err || (t = term(p)) == NULL) {
      return NULL;
    }

    while (!p->err && (p->sym == B_ADD || p->sym == B_SUB || 
                   p->sym == B_DOTADD || p->sym == B_DOTSUB ||
                   p->sym == B_HCAT || p->sym == B_VCAT ||
                   p->sym == B_LCAT || p->sym == B_RANGE)) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = term(p);
      }
    }

#if SDEBUG
    notify("expr4", t, p);
#endif

    return t;
}

static NODE *expr3 (parser *p)
{  
    NODE *t;

    if (p->err || (t = expr4(p)) == NULL) {
      return NULL;
    }

    while (!p->err && (p->sym == B_GT || p->sym == B_LT || 
                   p->sym == B_DOTGT || p->sym == B_DOTLT || 
                   p->sym == B_GTE || p->sym == B_LTE)) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = expr4(p);
      }
    }

#if SDEBUG
    notify("expr3", t, p);
#endif

    return t;
}

static NODE *expr2 (parser *p)
{  
    NODE *t;

    if (p->err || (t = expr3(p)) == NULL) {
      return NULL;
    }

    while (!p->err && (p->sym == B_EQ || p->sym == B_NEQ ||
                   p->sym == B_DOTEQ)) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = expr3(p);
      }
    }

#if SDEBUG
    notify("expr2", t, p);
#endif

    return t;
}

static NODE *expr1 (parser *p)
{  
    NODE *t;

    if (p->err || (t = expr2(p)) == NULL) {
      return NULL;
    }

    while (!p->err && p->sym == B_AND) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = expr2(p);
      }
    }

#if SDEBUG
    notify("expr1", t, p);
#endif

    return t;
}

NODE *expr0 (parser *p)
{  
    NODE *t;

    if (p->err || (t = expr1(p)) == NULL) {
      return NULL;
    }

    while (!p->err && p->sym == B_OR) {
      t = newb2(p->sym, t, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b2.r = expr1(p);
      }
    }

#if SDEBUG
    notify("expr0", t, p);
#endif

    return t;
}

NODE *expr (parser *p)
{  
    NODE *t;

    if (p->err || (t = expr0(p)) == NULL) {
      return NULL;
    }

    while (!p->err && p->sym == QUERY) {
      t = newb3(p->sym, t, NULL, NULL);
      if (t != NULL) {
          lex(p);
          t->v.b3.m = expr(p);
          if (p->sym == P_COL) {
            lex(p);
            t->v.b3.r = expr(p);
          } else {
            expected_symbol_error(':', p);
          }
      }
    }

#if SDEBUG
    notify("expr", t, p);
#endif

    return t;
}

/* for use when we need to evaluate a sub-matrix specification
   on the left-hand side of a genr formula */

NODE *msl_node_direct (parser *p)
{
    NODE *t;

    t = newb2(MSL2, NULL, NULL);
    if (t != NULL) {
      lex(p);
      get_slice_parts(t, p);
    }

    return t;
}

Generated by  Doxygen 1.6.0   Back to index