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