home *** CD-ROM | disk | FTP | other *** search
/ CICA 1995 May / cica_0595_4.zip / cica_0595_4 / UTIL / MSWSRC35 / PARSE.CPP < prev    next >
C/C++ Source or Header  |  1993-09-03  |  15KB  |  520 lines
  1.  
  2. /*
  3. *      parse.c         logo parser module              dvb
  4. *
  5. *    Copyright (C) 1989 The Regents of the University of California
  6. *    This Software may be copied and distributed for educational,
  7. *    research, and not for profit purposes provided that this
  8. *    copyright and statement are included in all such copies.
  9. *
  10. */
  11.  
  12. #include "logo.h"
  13. #include "globals.h"
  14. #ifdef unix
  15. #include <sgtty.h>
  16. #endif
  17. #include <ctype.h>
  18. #ifdef ibm
  19. #include <bios.h>
  20. extern int getch(void);
  21. #endif
  22. #ifdef __ZTC__
  23. #include <disp.h>
  24. #endif
  25.  
  26. #ifndef TIOCSTI
  27. #include <setjmp.h>
  28. extern jmp_buf iblk_buf;
  29. #endif
  30.  
  31. FILE *readstream = stdin;
  32. FILE *writestream = stdout;
  33. FILE *loadstream = stdin;
  34. FILE *dribblestream = NULL;
  35. int input_blocking = 0;
  36. int input_mode = 0;
  37.  
  38. int buffer_length = 0;
  39. int buffer_index = 0;
  40. char buffer_input[MAX_BUFFER_SIZE];
  41. char *p_line;
  42.  
  43. int rd_getc(FILE *strm)
  44.    {
  45.    int c;
  46.    
  47.    if (strm != stdin) 
  48.       {
  49.       c = getc(strm);
  50.       }
  51.    else
  52.       {
  53.       if (buffer_index+1 > buffer_length)
  54.          {
  55.          switch (input_mode)
  56.          {
  57.          case    TO_MODE: promptuser(buffer_input,"To Mode (Enter END to Exit)"); break;                      
  58.          case  LIST_MODE: promptuser(buffer_input,"List Mode"); break;                      
  59.          case PAUSE_MODE: promptuser(buffer_input,"Pause Mode (Enter CONTINUE to Exit)"); break;                      
  60.          case    NO_MODE: promptuser(buffer_input,"Input Mode"); break;                      
  61.          }
  62.          check_ibm_stop();
  63.          strcat(buffer_input,"\n");
  64.          buffer_length = strlen(buffer_input);
  65.          buffer_index = 0;
  66.          }
  67.       c = buffer_input[buffer_index++];
  68.       }
  69.    
  70.    return(c);
  71.    }
  72.  
  73. void rd_print_prompt(char *str)
  74.    {
  75.    /*
  76.    int ch;
  77.    
  78. #ifdef ibm
  79. #ifdef __ZTC__
  80.    if (in_graphics_mode && !in_splitscreen)
  81. #else
  82.    if (in_graphics_mode && ibm_screen_top == 0)
  83. #endif
  84.    lsplitscreen();
  85. #endif
  86.    ndprintf(stdout,"%t",str);
  87. #ifdef __ZTC__
  88.    zflush();
  89. #endif
  90.    */
  91.    }
  92.  
  93. #ifdef __ZTC__
  94.    void zrd_print_prompt(char *str) {
  95.    newline_bugfix();
  96.    rd_print_prompt(str);
  97.    }
  98. #else
  99. #define zrd_print_prompt rd_print_prompt
  100. #endif
  101.  
  102. NODE *reader(FILE *strm, char *prompt)
  103. {
  104.     int c, dribbling, vbar = 0;
  105.     char *phys_line;
  106.     char *p_line;
  107. //    char p_line[5000];
  108.     NODETYPES this_type = STRING;
  109.     NODE *ret;
  110.  
  111.     p_line = (char *)malloc(MAX_PHYS_LINE);
  112.  
  113.     charmode_off();
  114.     dribbling = (dribblestream != NULL && strm == stdin);
  115.     phys_line = p_line;
  116.     if (strm == stdin && *prompt) {
  117.     if (interactive) rd_print_prompt(prompt);
  118.     if (dribblestream != NULL)
  119.         fprintf(dribblestream, "%s", prompt);
  120.     }
  121.     if (strm == stdin) {
  122.     input_blocking++;
  123.     erract_errtype = FATAL;
  124.     }
  125.  
  126. #ifndef TIOCSTI
  127.     if (!setjmp(iblk_buf)) {
  128. #endif
  129.     c = rd_getc(strm);
  130.     while (c != EOF && (vbar || c != '\n')) {
  131.     if (dribbling) putc(c, dribblestream);
  132.     if (c == '\\' && (c = rd_getc(strm)) != EOF) {
  133.         if (dribbling) putc(c, dribblestream);
  134.             if (c == 'n') c = '\n'; //ggm
  135.         c = setparity(c);
  136.         this_type = BACKSLASH_STRING;
  137.         if (c == setparity('\n') && strm == stdin) {
  138.         if (interactive) zrd_print_prompt("\\ ");
  139.         if (dribbling)
  140.             fprintf(dribblestream, "\\ ");
  141.         }
  142.     }
  143.     if (c != EOF) *phys_line++ = c;
  144.     if (c == '|') vbar = !vbar;
  145.     if (/* vbar && */ c == '\n') {
  146.         if (strm == stdin) {
  147.         if (interactive) zrd_print_prompt("| ");
  148.         if (dribbling)
  149.             fprintf(dribblestream, "| ");
  150.         }
  151.     }
  152.     while (!vbar && c == '~' && (c = rd_getc(strm)) != EOF) {
  153.         while (c == ' ' || c == '\t')
  154.         c = rd_getc(strm);
  155.         if (dribbling) putc(c, dribblestream);
  156.         *phys_line++ = c;
  157.         if (c == '\n' && strm == stdin) {
  158.         if (interactive) zrd_print_prompt("~ ");
  159.         if (dribbling)
  160.             fprintf(dribblestream, "~ ");
  161.         }
  162.     }
  163.     if (c != EOF) c = rd_getc(strm);
  164.     }
  165. #ifndef TIOCSTI
  166.     }
  167. #endif
  168.     *phys_line = '\0';
  169.     input_blocking = 0;
  170. #ifdef __ZTC__
  171.     fix_cursor();
  172.     if (interactive && strm == stdin) newline_bugfix();
  173. #endif
  174.     if (dribbling)
  175.     putc('\n', dribblestream);
  176.     if (c == EOF && strm == stdin) {
  177.     if (interactive) clearerr(stdin);
  178.     rd_print_prompt("\n");
  179.     }
  180.     if (phys_line == p_line)
  181.       {
  182.       free(p_line);
  183.       return(Null_Word); /* so emptyp works */
  184.       }
  185.  
  186.     ret = make_strnode(p_line, (char *)NULL, (int)strlen(p_line),
  187.                this_type, strnzcpy);
  188.     free(p_line);
  189.     return(ret);
  190. }
  191.  
  192. NODE *list_to_array(NODE *list)
  193.    {
  194.    NODE *np = list, *result;
  195.    int len = 0, i;
  196.    
  197.    for (; np; np = cdr(np)) len++;
  198.    
  199.    result = make_array(len);
  200.    setarrorg(result,1);
  201.    
  202.    for (i = 0, np = list; np; np = cdr(np))
  203.    (getarrptr(result))[i++] = vref(car(np));
  204.    
  205.    return(result);
  206.    }
  207.  
  208. #define parens(ch)      (ch == '(' || ch == ')' || ch == ';')
  209. #define infixs(ch)      (ch == '*' || ch == '/' || ch == '+' || ch == '-' || ch == '=' || ch == '<' || ch == '>')
  210. #define white_space(ch) (ch == ' ' || ch == '\t')
  211.  
  212. NODE *parser_iterate(char **inln, char *inlimit, char *inhead,
  213. BOOLEAN semi, int endchar)
  214.    {
  215.    char ch, *wptr = NULL;
  216.    static char terminate = '\0';   /* KLUDGE */
  217.    NODE *outline = NIL, *lastnode = NIL, *tnode = NIL;
  218.    int windex = 0, vbar = 0;
  219.    NODETYPES this_type = STRING;
  220.    BOOLEAN broken = FALSE;
  221.    
  222.       do {
  223.       /* get the current character and increase pointer */
  224.       ch = **inln;
  225.       if (!vbar && windex == 0) wptr = *inln;
  226.       if (++(*inln) >= inlimit) *inln = &terminate;
  227.       
  228.       /* skip through comments and line continuations */
  229.       while (!vbar && ((semi && ch == ';') ||
  230.          (ch == '~' && **inln == '\n'))) {
  231.             while (ch == '~' && **inln == '\n') {
  232.             if (++(*inln) >= inlimit) *inln = &terminate;
  233.             ch = **inln;
  234.             if (windex == 0) wptr = *inln;
  235.                else {
  236.                if (**inln == ']' || **inln == '[' ||
  237.                **inln == '{' || **inln == '}')
  238.                   {
  239.                   ch = ' ';
  240.                   break;
  241.                   } else {
  242.                   broken = TRUE;
  243.                   }
  244.                }
  245.             if (++(*inln) >= inlimit) *inln = &terminate;
  246.             }
  247.          
  248.          if (semi && ch == ';')
  249.             do {
  250.             ch = **inln;
  251.             if (windex == 0) wptr = *inln;
  252.             else broken = TRUE;
  253.             if (++(*inln) >= inlimit) *inln = &terminate;
  254.             } while (ch != '\0' && ch != '~' && **inln != '\n');
  255.          }
  256.       
  257.       /* flag that this word will be of BACKSLASH_STRING type */
  258.       if (getparity(ch)) this_type = BACKSLASH_STRING;
  259.       
  260.          if (ch == '|') {
  261.          vbar = !vbar;
  262.          this_type = VBAR_STRING;
  263.          broken = TRUE; /* so we'll copy the chars */
  264.          }
  265.       
  266.       else if (vbar || (!white_space(ch) && ch != ']' &&
  267.       ch != '{' && ch != '}' &&
  268.       ch != '[' && ch != '\0'))
  269.       windex++;
  270.       
  271.       if (vbar) continue;
  272.       
  273.       else if (ch == endchar) break;
  274.       
  275.       else if (ch == ']') err_logo(UNEXPECTED_BRACKET, NIL);
  276.       else if (ch == '}') err_logo(UNEXPECTED_BRACE, NIL); /*{*/
  277.       
  278.       /* if this is a '[', parse a new list */
  279.          else if (ch == '[') {
  280.          tnode = cons(parser_iterate(inln,inlimit,inhead,semi,']'), NIL);
  281.          if (**inln == '\0') ch = '\0';
  282.          }
  283.       
  284.          else if (ch == '{') {
  285.          tnode = cons(list_to_array
  286.          (parser_iterate(inln,inlimit,inhead,semi,'}')), NIL); /*{*/
  287.             if (**inln == '@') {
  288.             int i = 0, sign = 1;
  289.             
  290.             (*inln)++;
  291.                if (**inln == '-') {
  292.                sign = -1;
  293.                (*inln)++;
  294.                }
  295.                while ((ch = **inln) >= '0' && ch <= '9') {
  296.                i = (i*10) + ch - '0';
  297.                (*inln)++;
  298.                }
  299.             setarrorg(car(tnode),sign*i);
  300.             }
  301.          if (**inln == '\0') ch = '\0';
  302.          }
  303.       
  304.       /* if this character or the next one will terminate string, make the word */
  305.       else if (white_space(ch) || ch == '\0' ||
  306.       **inln == ']' || **inln == '[' ||
  307.       **inln == '{' || **inln == '}')
  308.          {
  309.             if (windex > 0) {
  310.             if (broken == FALSE)
  311.             tnode = cons(make_strnode(wptr, inhead, windex,
  312.             this_type, strnzcpy),
  313.             NIL);
  314.                else {
  315.                tnode = cons(make_strnode(wptr, (char *)NULL, windex,
  316.                this_type, (semi ? mend_strnzcpy : mend_nosemi)),
  317.                NIL);
  318.                broken = FALSE;
  319.                }
  320.             this_type = STRING;
  321.             windex = 0;
  322.             }
  323.          }
  324.       
  325.       /* put the word onto the end of the return list */
  326.          if (tnode != NIL) {
  327.          if (outline == NIL) outline = vref(tnode);
  328.          else setcdr(lastnode, tnode);
  329.          lastnode = tnode;
  330.          tnode = NIL;
  331.          }
  332.       } while (ch);
  333.    return(unref(outline));
  334.    }
  335.  
  336. NODE *parser(NODE *nd, BOOLEAN semi)
  337.    {
  338.    NODE *rtn;
  339.    int slen;
  340.    char *lnsav;
  341.    
  342.    rtn = cnv_node_to_strnode(nd);
  343.    ref(rtn);
  344.    gcref(nd);
  345.    slen = getstrlen(rtn);
  346.    lnsav = getstrptr(rtn);
  347.    rtn = reref(rtn,
  348.    parser_iterate(&lnsav,lnsav + slen,getstrhead(rtn),semi,-1));
  349.    return(unref(rtn));
  350.    }
  351.  
  352. NODE *lparse(NODE *args)
  353.    {
  354.    NODE *arg, *val = UNBOUND;
  355.    
  356.    arg = string_arg(args);
  357.       if (NOT_THROWING) {
  358.       val = parser(arg, FALSE);
  359.       }
  360.    return(val);
  361.    }
  362.  
  363. NODE *runparse_node(NODE *nd, NODE **ndsptr)
  364.    {
  365.    NODE *outline = NIL, *tnode = NIL, *lastnode = NIL, *snd;
  366.    char *wptr, *tptr, *whead;
  367.    int wlen, wcnt, tcnt, isnumb;
  368.    NODETYPES wtyp;
  369.    BOOLEAN monadic_minus = FALSE;
  370.    
  371.    if (nd == Minus_Tight) return cons(nd, NIL);
  372.    snd = cnv_node_to_strnode(nd);
  373.    ref(snd);
  374.    wptr = getstrptr(snd);
  375.    wlen = getstrlen(snd);
  376.    wtyp = nodetype(snd);
  377.    wcnt = 0;
  378.    whead = getstrhead(snd);
  379.    
  380.       while (wcnt < wlen) {
  381.          if (*wptr == ';') {
  382.          *ndsptr = NIL;
  383.          break;
  384.          }
  385.          if (*wptr == '"') {
  386.          tcnt = 0;
  387.          tptr = ++wptr;
  388.          wcnt++;
  389.             while (wcnt < wlen && !parens(*wptr)) {
  390.             if (wtyp == BACKSLASH_STRING && getparity(*wptr))
  391.             wtyp = PUNBOUND;    /* flag for "\( case */
  392.             wptr++, wcnt++, tcnt++;
  393.             }
  394.             if (wtyp == PUNBOUND) {
  395.             wtyp = BACKSLASH_STRING;
  396.             tnode = cons(make_quote(intern(make_strnode(tptr, NULL,
  397.             tcnt, wtyp, noparity_strnzcpy))), NIL);
  398.             } else
  399.          tnode = cons(make_quote(intern(make_strnode(tptr, whead, tcnt,
  400.          wtyp, strnzcpy))), NIL);
  401.          } else if (*wptr == ':') {
  402.          tcnt = 0;
  403.          tptr = ++wptr;
  404.          wcnt++;
  405.          while (wcnt < wlen && !parens(*wptr) && !infixs(*wptr))
  406.          wptr++, wcnt++, tcnt++;
  407.          tnode = cons(make_colon(intern(make_strnode(tptr, whead, tcnt,
  408.          wtyp, strnzcpy))), NIL);
  409.          } else if (wcnt == 0 && *wptr == '-' && monadic_minus == FALSE &&
  410.          !white_space(*(wptr+1))) {
  411.          /* minus sign with space before and no space after is unary */
  412.          tnode = cons(make_intnode((FIXNUM)0), NIL);
  413.          monadic_minus = TRUE;
  414.          } else if (parens(*wptr) || infixs(*wptr)) {
  415.          if (monadic_minus)
  416.          tnode = cons(Minus_Tight, NIL);
  417.          else
  418.          tnode = cons(intern(make_strnode(wptr, whead, 1,
  419.          STRING, strnzcpy)), NIL);
  420.          monadic_minus = FALSE;
  421.          wptr++, wcnt++;
  422.          }
  423.       else
  424.          {
  425.          tcnt = 0;
  426.          tptr = wptr;
  427.          /* isnumb 0 means digits so far, 1 means just saw
  428.          * 'e' so minus can be next, 2 means no longer
  429.          * eligible even if an 'e' comes along */
  430.          isnumb = 0;
  431.             if (*wptr == '?') {
  432.             isnumb = 3; /* turn ?5 to (? 5) */
  433.             wptr++, wcnt++, tcnt++;
  434.             }
  435.          while (wcnt < wlen && !parens(*wptr) &&
  436.             (!infixs(*wptr) || (isnumb == 1 && *wptr == '-'))) {
  437.             if (isnumb == 0 && (*wptr == 'e' || *wptr == 'E'))
  438.             isnumb = 1;
  439.             else if (!(isdigit(*wptr) || *wptr == '.') || isnumb == 1)
  440.             isnumb = 2;
  441.             wptr++, wcnt++, tcnt++;
  442.             }
  443.             if (isnumb == 3 && tcnt > 1) {    /* ?5 syntax */
  444.             NODE *qmtnode;
  445.             
  446.             qmtnode = cons_list(0, Left_Paren, Query,
  447.             cnv_node_to_numnode
  448.             (make_strnode(tptr+1, whead,
  449.             tcnt-1, wtyp, strnzcpy)),
  450.             END_OF_LIST);
  451.                if (outline == NIL) {
  452.                outline = vref(qmtnode);
  453.                } else {
  454.                setcdr(lastnode, qmtnode);
  455.                }
  456.             lastnode = cddr(qmtnode);
  457.             tnode = cons(Right_Paren, NIL);
  458.             } else if (isnumb < 2 && tcnt > 0) {
  459.             tnode = cons(cnv_node_to_numnode(make_strnode(tptr, whead, tcnt,
  460.                                                         wtyp, strnzcpy)),NIL);
  461.             } else
  462.          tnode = cons(intern(make_strnode(tptr, whead, tcnt,
  463.          wtyp, strnzcpy)),NIL);
  464.          }
  465.       
  466.       if (outline == NIL) outline = vref(tnode);
  467.       else setcdr(lastnode, tnode);
  468.       lastnode = tnode;
  469.       }
  470.    deref(snd);
  471.    return(unref(outline));
  472.    }
  473.  
  474. NODE *runparse(NODE *ndlist)
  475.    {
  476.    NODE *curnd = NIL, *outline = NIL, *tnode = NIL, *lastnode = NIL;
  477.    
  478.    if (nodetype(ndlist) == RUN_PARSE)
  479.    return parsed__runparse(ndlist);
  480.       while (ndlist != NIL) {
  481.       curnd = car(ndlist);
  482.       ndlist = cdr(ndlist);
  483.       if (!is_word(curnd))
  484.       tnode = cons(curnd, NIL);
  485.          else {
  486.          if (!numberp(curnd))
  487.          tnode = runparse_node(curnd, &ndlist);
  488.          else
  489.          tnode = cons(cnv_node_to_numnode(curnd), NIL);
  490.          }
  491.          if (tnode != NIL) {
  492.          if (outline == NIL) outline = vref(tnode);
  493.          else setcdr(lastnode, tnode);
  494.          lastnode = tnode;
  495.             while (cdr(lastnode) != NIL) {
  496.             lastnode = cdr(lastnode);
  497.             if (check_throwing) break;
  498.             }
  499.          }
  500.       if (check_throwing) break;
  501.       }
  502.    return(unref(outline));
  503.    }
  504.  
  505. NODE *lrunparse(NODE *args)
  506.    {
  507.    NODE *arg;
  508.    
  509.    arg = car(args);
  510.       while (nodetype(arg) == ARRAY && NOT_THROWING) {
  511.       setcar(args, err_logo(BAD_DATA, arg));
  512.       arg = car(args);
  513.       }
  514.    if (NOT_THROWING && !aggregate(arg))
  515.    arg = parser(arg, TRUE);
  516.    if (NOT_THROWING)
  517.    return runparse(arg);
  518.    return UNBOUND;
  519.    }
  520.