home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / intercal.zip / src / ick.y < prev    next >
Text File  |  1996-06-19  |  11KB  |  376 lines
  1. /*****************************************************************************
  2.  
  3. NAME
  4.     ick.y -- grammar for the INTERCAL language
  5.  
  6. DESCRIPTION 
  7.    This YACC grammar parses the INTERCAL language by designed by Don R. Woods
  8. and James M. Lyon.  There are two syntax extensions over the original
  9. INTERCAL-72 language; the COME FROM statement, and the prefixed forms of the
  10. WHIRL operator.
  11.  
  12. LICENSE TERMS
  13.     Copyright (C) 1996 Eric S. Raymond 
  14.  
  15.     This program is free software; you can redistribute it and/or modify
  16.     it under the terms of the GNU General Public License as published by
  17.     the Free Software Foundation; either version 2 of the License, or
  18.     (at your option) any later version.
  19.  
  20.     This program is distributed in the hope that it will be useful,
  21.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  22.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23.     GNU General Public License for more details.
  24.  
  25.     You should have received a copy of the GNU General Public License
  26.     along with this program; if not, write to the Free Software
  27.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  28.  
  29. *****************************************************************************/
  30.  
  31. %{
  32. #include <stdio.h>
  33. #include "sizes.h"
  34. #include "ick.h"
  35. #include "feh.h"
  36. #include "lose.h"
  37.  
  38. extern int yyerror(char*);
  39.  
  40. /* Intervene our first-stage lexer. */
  41. extern int lexer(void);
  42. #define yylex() lexer()
  43.  
  44. static node *rlist;    /* pointer to current right-hand node list */
  45. /*static node *llist;*/    /* pointer to current left-hand node list */
  46. static node *np;    /* variable for building node lists */
  47.  
  48. extern int stbeginline;    /* line number of last seen preamble */
  49. static int thisline;    /* line number of beginning of current statement */
  50. static tuple *splat(void);
  51.  
  52. #define GETLINENO                    \
  53.     {if (stbeginline < 0) thisline = -stbeginline;    \
  54.      else {thisline = stbeginline; stbeginline = 0;}}
  55.  
  56. #define ACTION(x, nt, nn)    \
  57.     {x = newtuple(); x->type = nt; x->lineno = thisline; x->u.node = nn;}
  58. #define TARGET(x, nt, nn)    \
  59.     {x = newtuple(); x->type = nt; x->lineno = thisline; x->u.target = nn;}
  60. #define NEWFANGLED    if (traditional) lose(E111,yylineno,(char*)NULL); else
  61.  
  62. %}
  63.  
  64. %start program
  65.  
  66. %union
  67. {
  68.     int        numval;        /* a numeric value */
  69.     tuple    *tuple;        /* a code tuple */
  70.     node    *node;        /* an expression-tree node */
  71. }
  72.  
  73. /*
  74.  * Don't change this statement token list gratuitously!
  75.  * Some code in feh.c depends on GETS being the least
  76.  * statement type and on the order of the ones following.
  77.  */
  78. %token GETS RESIZE NEXT FORGET RESUME STASH RETRIEVE IGNORE REMEMBER ABSTAIN
  79. %token REINSTATE DISABLE ENABLE GIVE_UP READ_OUT WRITE_IN COME_FROM
  80.  
  81. %token DO PLEASE NOT MESH ONESPOT TWOSPOT TAIL HYBRID
  82. %token MINGLE SELECT SPARK EARS SUB BY BADCHAR
  83.  
  84. %token <numval> NUMBER UNARY OHOHSEVEN GERUND LABEL
  85. %token <node> INTERSECTION
  86.  
  87. /*
  88.  * These are not tokens returned by the lexer, but they are used as
  89.  * tokens elsewhere.  We define them here to insure that the values
  90.  * will not conflict with the other tokens.  It is important that
  91.  * WHIRL through WHIRL5 be a continuous sequence.
  92.  */
  93. %token SPLATTERED TESTNZ C_AND C_OR C_XOR C_NOT EQUALS AND OR XOR FIN MESH32
  94. %token WHIRL WHIRL2 WHIRL3 WHIRL4 WHIRL5
  95.  
  96. %type <node> expr varlist variable constant lvalue inlist outlist
  97. %type <node> subscr byexpr scalar array initem outitem sublist
  98. %type <node> unambig subscr1 sublist1 oparray osubscr osubscr1
  99. %type <tuple> perform
  100. %type <numval> please preftype
  101.  
  102. %nonassoc EARS SPARK
  103. %nonassoc HIGHPREC
  104.  
  105. %%    /* beginning of rules section */
  106.  
  107. /* A program description consists of a sequence of statements */
  108. program    :    /* EMPTY */
  109.     |    program command
  110.     ;
  111.  
  112. /*
  113.  * Each command consists of an optional label, followed by a preamble,
  114.  * followed by an optional probability, followed by the statement body.
  115.  * Negative exechance values indicate initial abstentions, and will be
  116.  * made positive before code is emitted.
  117.  */
  118. command    :    please perform
  119.         {$2->label = 0; $2->exechance = $1 * 100;}
  120.     |    please OHOHSEVEN perform
  121.         {$3->label = 0; $3->exechance = $1 * $2;}
  122.     |    LABEL please perform
  123.         {checklabel($1); $3->label = $1; $3->exechance = $2 * 100;}
  124.     |    LABEL please OHOHSEVEN perform
  125.         {checklabel($1); $4->label = $1; $4->exechance = $2 * $3;}
  126.     |    error
  127.         {lose(E017, yylineno, (char *)NULL);}
  128.     ;
  129.  
  130. /* There are two forms of preamble returned by the lexer */
  131. please    :    DO            {GETLINENO; $$ = 1;}
  132.     |    DO NOT        {GETLINENO; $$ = -1;}
  133.     ;
  134.  
  135. /* Here's how to parse statement bodies */
  136. perform :    lvalue GETS expr    {ACTION($$, GETS,      cons(GETS,$1,$3));}
  137.     |    array GETS byexpr    {ACTION($$, RESIZE,    cons(RESIZE,$1,$3));}
  138.     |    LABEL NEXT        {TARGET($$, NEXT,      $1);}
  139.     |    FORGET expr    {ACTION($$, FORGET,    $2);}
  140.     |    RESUME expr    {ACTION($$, RESUME,    $2);}
  141.     |    STASH varlist    {ACTION($$, STASH,     rlist);}
  142.     |    RETRIEVE varlist    {ACTION($$, RETRIEVE,  rlist);}
  143.     |    IGNORE varlist    {ACTION($$, IGNORE,    rlist);}
  144.     |    REMEMBER varlist    {ACTION($$, REMEMBER,  rlist);}
  145.     |    ABSTAIN LABEL    {TARGET($$, ABSTAIN,   $2);}
  146.     |    ABSTAIN gerunds    {ACTION($$, DISABLE,   rlist);}
  147.     |    REINSTATE LABEL    {TARGET($$, REINSTATE, $2);}
  148.     |    REINSTATE gerunds    {ACTION($$, ENABLE,    rlist);}
  149.     |    WRITE_IN inlist    {ACTION($$, WRITE_IN,  $2);}
  150.     |    READ_OUT outlist    {ACTION($$, READ_OUT,  $2);}
  151.     |    GIVE_UP        {ACTION($$, GIVE_UP,   0);}
  152.     |    COME_FROM LABEL    {NEWFANGLED {TARGET($$,COME_FROM,$2)}}
  153.     |    BADCHAR        {yyclearin; $$ = splat();}
  154.     |    error        {yyclearin; $$ = splat();}
  155.     ;
  156.  
  157. /* gerund lists are used by ABSTAIN and REINSTATE */
  158. gerunds    :   GERUND
  159.         {rlist = np = newnode(); np->constant = $1;}
  160.     |   gerunds INTERSECTION GERUND
  161.         {
  162.             np->rval = newnode();
  163.             np = np->rval;
  164.             np->constant = $3;
  165.         } 
  166.     ;
  167.  
  168. /* OK, here's what a variable reference looks like */
  169. variable:    scalar | array;
  170.    
  171. lvalue    :    scalar | subscr;
  172.  
  173. scalar    :    ONESPOT NUMBER
  174.         {
  175.             $$ = newnode();
  176.             $$->opcode = ONESPOT;
  177.             $$->constant = intern(ONESPOT, $2);
  178.         }
  179.     |    TWOSPOT NUMBER
  180.         {
  181.             $$ = newnode();
  182.             $$->opcode = TWOSPOT;
  183.             $$->constant = intern(TWOSPOT, $2);
  184.         }
  185.     ;
  186.  
  187. array    :    TAIL NUMBER
  188.         {
  189.             $$ = newnode();
  190.             $$->opcode = TAIL;
  191.             $$->constant = intern(TAIL, $2);
  192.         }
  193.     |    HYBRID NUMBER
  194.         {
  195.             $$ = newnode();
  196.             $$->opcode = HYBRID;
  197.             $$->constant = intern(HYBRID, $2);
  198.         }
  199.     ;
  200.  
  201. /* Array with unary operator is a special intermediate case; these
  202.    nodes will be rearranged when the subscript list is added */
  203. oparray :    TAIL UNARY NUMBER
  204.         {
  205.             $$ = newnode();
  206.             $$->opcode = $2;
  207.             $$->rval = newnode();
  208.             $$->rval->opcode = TAIL;
  209.             $$->rval->constant = intern(TAIL, $3);
  210.         }
  211.         |    HYBRID UNARY NUMBER
  212.         {
  213.             $$ = newnode();
  214.             $$->opcode = $2;
  215.             $$->rval = newnode();
  216.             $$->rval->opcode = HYBRID;
  217.             $$->rval->constant = intern(HYBRID, $3);
  218.         }
  219.         ;
  220.  
  221. /* And a constant looks like this */
  222. constant:   MESH NUMBER
  223.         {
  224.             /* enforce the 16-bit constant constraint */
  225.             if ((unsigned int)$2 > Max_small)
  226.             lose(E017, yylineno, (char *)NULL);
  227.             $$ = newnode();
  228.             $$->opcode = MESH;
  229.             $$->constant = $2;
  230.         }
  231.     ;
  232.  
  233. /* variable lists are used in STASH, RETRIEVE, IGNORE, REMEMBER */
  234. varlist :   variable                {rlist = np = $1;}
  235.     |   varlist INTERSECTION variable    {np = np->rval = $3;
  236.                             /* newnode(); */ }
  237.     ;
  238.  
  239. /* scalars and subscript exprs are permitted in WRITE IN lists */
  240. /* new: arrays are also permitted to allow for bitwise I/0 */
  241. initem    :    scalar | subscr | array;
  242. inlist    :    initem INTERSECTION inlist        {$$=cons(INTERSECTION,$1,$3);}
  243.     |    initem                {$$=cons(INTERSECTION,$1,0);}
  244.  
  245. /* scalars, subscript exprs & constants are permitted in READ OUT lists */
  246. /* new: arrays are also permitted to allow for bitwise I/0 */
  247. outitem    :    scalar | subscr | constant | array;
  248. outlist    :    outitem INTERSECTION outlist    {$$=cons(INTERSECTION,$1,$3);}
  249.     |    outitem                {$$=cons(INTERSECTION,$1,0);}
  250.     ;
  251.  
  252. /* Now the gnarly part -- expression syntax */
  253.  
  254. /* Support array dimension assignment */
  255. byexpr    :   expr BY byexpr        {$$ = cons(BY, $1, $3);}
  256.     |   expr            {$$ = cons(BY, $1, 0);}
  257.     ;
  258.  
  259. /* Support array subscripts (as lvalues) */
  260. subscr  :   subscr1                {$$ = $1;}
  261.         |   array SUB sublist        {$$ = cons(SUB, $1, $3);}
  262.     ;
  263. subscr1 :   array SUB sublist1        {$$ = cons(SUB, $1, $3);}
  264.     ;
  265. sublist :   unambig sublist             {$$ = cons(INTERSECTION, $1, $2);}
  266.     |   unambig sublist1             {$$ = cons(INTERSECTION, $1, $2);}
  267.     ;
  268. sublist1:   subscr1                {$$ = cons(INTERSECTION, $1, 0);}
  269.         |   osubscr1                {$$ = cons(INTERSECTION, $1, 0);}
  270.         |   unambig     %prec HIGHPREC    {$$ = cons(INTERSECTION, $1, 0);}
  271.         ;
  272.  
  273. /* Unary operators with arrays act like arrays only in expressions */
  274. osubscr :   osubscr1                    {$$ = $1;}
  275.         |   oparray SUB sublist
  276.         {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);}
  277.     ;
  278. osubscr1:   oparray SUB sublist1
  279.         {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);}
  280.     ;
  281.  
  282. /* here goes the general expression syntax */
  283. expr    :   unambig                {$$ = $1;}
  284.     |   unambig SELECT unambig    {$$ = cons(SELECT, $1, $3);}
  285.     |   unambig SELECT subscr    {$$ = cons(SELECT, $1, $3);}
  286.     |   unambig SELECT osubscr    {$$ = cons(SELECT, $1, $3);}
  287.     |   unambig MINGLE unambig    {$$ = cons(MINGLE, $1, $3);}
  288.     |   unambig MINGLE subscr    {$$ = cons(MINGLE, $1, $3);}
  289.     |   unambig MINGLE osubscr    {$$ = cons(MINGLE, $1, $3);}
  290.     |   subscr            {$$ = $1;}
  291.     |   osubscr            {$$ = $1;}
  292.         ;
  293.  
  294. preftype:   MESH {$$=MESH; } | ONESPOT {$$=ONESPOT;} | TWOSPOT {$$=TWOSPOT;};
  295.  
  296. unambig    :   variable    {$$ = $1;}
  297.     |   constant    {$$ = $1;}
  298.  
  299.     /* deal with the bizarre unary-op syntax */
  300.     |    preftype UNARY NUMBER
  301.         {
  302.             $$ = newnode();
  303.             $$->opcode = $2;
  304.             $$->rval = newnode();
  305.             $$->rval->opcode = $1;
  306.             if($1 == MESH) {
  307.                 /* enforce the 16-bit constant constraint */
  308.                 if ((unsigned int)$3 > Max_small)
  309.                 lose(E017, yylineno, (char *)NULL);
  310.                 $$->rval->constant = $3;
  311.             }
  312.             else {
  313.             $$->rval->constant = intern($1, $3);
  314.             }
  315.         }
  316.  
  317.     /* Now deal with the screwy unary-op interaction with grouping */
  318.     |    SPARK UNARY expr SPARK
  319.         {
  320.             $$ = newnode();
  321.             $$->opcode = $2;
  322.             $$->rval = $3;
  323.         }
  324.     |    EARS UNARY expr EARS
  325.         {
  326.             $$ = newnode();
  327.             $$->opcode = $2;
  328.             $$->rval = $3;
  329.         }
  330.  
  331.     |    SPARK expr SPARK        {$$ = $2;}
  332.     |    EARS expr EARS        {$$ = $2;}
  333.     ;
  334.  
  335. %%
  336.  
  337. static tuple *splat(void)
  338. /* try to recover from an invalid statement. */
  339. {
  340.     tuple *sp;
  341.     int tok, i;
  342.     extern bool re_send_token;
  343.  
  344.     /*
  345.      * The idea
  346.      * here is to skip to the next DO, PLEASE or label, then unget that token.
  347.      * which we can do with a tricky flag on the lexer (re_send_token).
  348.      */
  349.  
  350.     /*    fprintf(stderr,"attempting to splat at line %d....\n",yylineno); */
  351.     for(i = 0,re_send_token = FALSE;;i++) {
  352.     tok = lexer();
  353.     if (!tok)
  354.     {
  355.         re_send_token = TRUE;
  356.         tok = ' ';        /* scanner must not see a NUL */
  357.         break;
  358.     }
  359.     else if (tok == DO || tok == PLEASE || tok == LABEL) {
  360.         re_send_token = TRUE;
  361.         break;
  362.     }
  363.     }
  364.     /*
  365.     fprintf(stderr,"found %d on line %d after %d other tokens.\n",
  366.         tok,yylineno,i);
  367.      */
  368.  
  369.     /* generate a placeholder tuple for the text line */
  370.     TARGET(sp, SPLATTERED, 0);
  371.  
  372.     return(sp);
  373. }
  374.  
  375. /* ick.y ends here */
  376.