|
996
|
1 /*****************************************************************************
|
|
|
2
|
|
|
3 NAME
|
|
|
4 parser.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 several syntax extensions over the original
|
|
|
9 INTERCAL-72 language.
|
|
|
10
|
|
|
11 LICENSE TERMS
|
|
|
12 Copyright (C) 1996 Eric S. Raymond
|
|
|
13
|
|
|
14 This program is free software; you can redistribute it and/or modify
|
|
|
15 it under the terms of the GNU General Public License as published by
|
|
|
16 the Free Software Foundation; either version 2 of the License, or
|
|
|
17 (at your option) any later version.
|
|
|
18
|
|
|
19 This program is distributed in the hope that it will be useful,
|
|
|
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
22 GNU General Public License for more details.
|
|
|
23
|
|
|
24 You should have received a copy of the GNU General Public License
|
|
|
25 along with this program; if not, write to the Free Software
|
|
|
26 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
27
|
|
|
28 *****************************************************************************/
|
|
|
29
|
|
|
30 %{
|
|
|
31 #include "config.h"
|
|
|
32 #include <stdio.h>
|
|
|
33 #include <stdlib.h>
|
|
|
34 #include "sizes.h"
|
|
|
35 #include "ick.h"
|
|
|
36 #include "feh.h"
|
|
|
37 #include "ick_lose.h"
|
|
|
38
|
|
|
39 extern int yyerror(const char*);
|
|
|
40
|
|
|
41 /* Intervene our ick_first-stage lexer. */
|
|
|
42 extern int lexer(void);
|
|
|
43 #define yylex() lexer()
|
|
|
44
|
|
|
45 static node *rlist; /* pointer to current right-hand node list */
|
|
|
46 /*static node *llist;*/ /* pointer to current left-hand node list */
|
|
|
47 static node *np; /* variable for building node lists */
|
|
|
48
|
|
|
49 extern int stbeginline; /* line number of last seen preamble */
|
|
|
50 static int thisline; /* line number of beginning of current statement */
|
|
|
51
|
|
|
52 extern int mark112; /* AIS: Mark the tuple for W112 when it's created. */
|
|
|
53 static int lineuid=65537; /* AIS: a line number not used anywhere else */
|
|
|
54 static int cacsofar=0; /* AIS: Number of args in a CREATE statement */
|
|
|
55
|
|
|
56 static tuple *splat(int);
|
|
|
57
|
|
|
58 static tuple *prevtuple = NULL;
|
|
|
59
|
|
|
60 #define GETLINENO \
|
|
|
61 {if (stbeginline < 0) thisline = -stbeginline; \
|
|
|
62 else {thisline = stbeginline; stbeginline = 0;}}
|
|
|
63
|
|
|
64 #define ACTION(x, nt, nn) \
|
|
|
65 {x = newtuple(); x->type = nt; x->ick_lineno = thisline; x->u.node = nn;}
|
|
|
66 #define TARGET(x, nt, nn) \
|
|
|
67 {x = newtuple(); x->type = nt; x->ick_lineno = thisline; x->u.target = nn;}
|
|
|
68 #define ACTARGET(x, nt, nn, nn2)\
|
|
|
69 {x = newtuple(); x->type = nt; x->ick_lineno = thisline;\
|
|
|
70 x->u.node = nn; x->u.target = nn2;}
|
|
|
71 /* AIS : The macro above was added for ABSTAIN expr FROM. */
|
|
|
72 #define NEWFANGLED mark112 = 1; /* AIS: Added the mention of mark112 */ \
|
|
|
73 if (ick_traditional) ick_lose(IE111,iyylineno,(char*)NULL); else
|
|
|
74
|
|
|
75 #define DESTACKSE1 sparkearsstack[sparkearslev--/32] >>= 1
|
|
|
76 #define DESTACKSPARKEARS DESTACKSE1; DESTACKSE1
|
|
|
77
|
|
|
78 %}
|
|
|
79
|
|
|
80 %start program
|
|
|
81
|
|
|
82 %union
|
|
|
83 {
|
|
|
84 int numval; /* a numeric value */
|
|
|
85 tuple *tuple; /* a code tuple */
|
|
|
86 node *node; /* an expression-tree node */
|
|
|
87 }
|
|
|
88
|
|
|
89 /*
|
|
|
90 * Don't change this statement token list gratuitously!
|
|
|
91 * Some code in feh2.c depends on GETS being the least
|
|
|
92 * statement type and on the order of the ones following.
|
|
|
93 * When adding a new statement, also update MAXTYPES in ick.h
|
|
|
94 * and the token list in feh2.c.
|
|
|
95 * AIS: Note that although GETS is the lowest statement type (with index 0
|
|
|
96 * in feh2.c), UNKNOWN (i.e. a line that causes error 000) is an even
|
|
|
97 * lower statement type, with index -1. perpet.c uses indexes 1 higher.
|
|
|
98 * AIS: Added FROM, MANYFROM, TRY_AGAIN, COMPUCOME, GERUCOME, WHILE, three
|
|
|
99 * NEXT FROM cases, and CREATE. Also added PREPROC; this is for when the
|
|
|
100 * parser acts like a preprocessor, translating an INTERCAL statement into
|
|
|
101 * a sequence of INTERCAL statements with the same net effect.
|
|
|
102 * AIS: COME_FROM now merged with the label following it,
|
|
|
103 * to distinguish it from COMPUCOME, in the lexer. This changes
|
|
|
104 * the parser somewhat.
|
|
|
105 */
|
|
|
106 %token UNKNOWN /* AIS: This is so comments can be REINSTATED */
|
|
|
107 %token GETS RESIZE NEXT GO_AHEAD GO_BACK FORGET RESUME STASH RETRIEVE IGNORE
|
|
|
108 %token REMEMBER ABSTAIN REINSTATE
|
|
|
109 %token DISABLE ENABLE MANYFROM GIVE_UP READ_OUT WRITE_IN /* AIS: */PIN
|
|
|
110 %token <numval> COME_FROM NEXTFROMLABEL
|
|
|
111 %token NEXTFROMEXPR NEXTFROMGERUND COMPUCOME GERUCOME
|
|
|
112 %token PREPROC WHILE TRY_AGAIN
|
|
|
113 %token <numval> CREATE
|
|
|
114 %token COMPUCREATE FROM
|
|
|
115
|
|
|
116 /* AIS: ONCE and AGAIN added, for multithread support; also, NOSPOT added,
|
|
|
117 so that I can reserve _ for future use (it's nowhere in the grammar yet) */
|
|
|
118 %token MAYBE DO PLEASE NOT ONCE AGAIN MESH NOSPOT ick_ONESPOT ick_TWOSPOT ick_TAIL ick_HYBRID
|
|
|
119 %token MINGLE SELECT UNKNOWNOP /* AIS: SPARK EARS */ SUB BY
|
|
|
120 /* AIS: For operand overloading */
|
|
|
121 %token SLAT BACKSLAT
|
|
|
122
|
|
|
123 %token <numval> NUMBER UNARY OHOHSEVEN GERUND LABEL BADCHAR
|
|
|
124 %token <node> INTERSECTION
|
|
|
125
|
|
|
126 /*
|
|
|
127 * These are not tokens returned by the lexer, but they are used as
|
|
|
128 * tokens elsewhere. We define them here to insure that the values
|
|
|
129 * will not conflict with the other tokens. It is important that
|
|
|
130 * WHIRL through WHIRL5 be a continuous sequence.
|
|
|
131 */
|
|
|
132 /* AIS: Added new tokens for optimizer output */
|
|
|
133 %token SPLATTERED MESH32
|
|
|
134 %token C_AND C_OR C_XOR C_NOT C_LOGICALNOT C_LSHIFTBY C_RSHIFTBY
|
|
|
135 %token C_NOTEQUAL C_A C_PLUS C_MINUS C_TIMES C_DIVIDEBY C_MODULUS
|
|
|
136 %token C_GREATER C_LESS C_ISEQUAL C_LOGICALAND C_LOGICALOR
|
|
|
137 /* The reverse unary operators have to be in the same order as the forward
|
|
|
138 unary operators. */
|
|
|
139 %token AND OR XOR FIN WHIRL WHIRL2 WHIRL3 WHIRL4 WHIRL5
|
|
|
140 %token REV_AND REV_OR REV_XOR REV_FIN
|
|
|
141 %token REV_WHIRL REV_WHIRL2 REV_WHIRL3 REV_WHIRL4 REV_WHIRL5
|
|
|
142 /* (AIS) Tokens for just-in-case compilation; UNKNOWNID is returned by the
|
|
|
143 lexer for unknown 'identifiers'. And yes, it does contain a number. */
|
|
|
144 %token <numval> UNKNOWNID
|
|
|
145 /* (AIS) Five possibilities for an unknown statement chain: identifiers,
|
|
|
146 scalars, arrays, array elements, and other expressions. */
|
|
|
147 %token US_ID US_SCALAR US_ARRVAR US_ELEM US_EXPR
|
|
|
148
|
|
|
149 %type <node> expr limexpr varlist variable constant lvalue inlist outlist
|
|
|
150 %type <node> subscr byexpr scalar scalar2s ick_array initem outitem sublist
|
|
|
151 %type <node> unambig limunambig subscr1 sublist1 oparray osubscr osubscr1
|
|
|
152 %type <node> notanlvalue nlunambig lunambig unknownstatement unknownatom
|
|
|
153 %type <node> unknownsin unknownsif unknownaid unop
|
|
|
154 %type <tuple> preproc perform mtperform
|
|
|
155 %type <numval> please preftype
|
|
|
156
|
|
|
157 %nonassoc OPENEARS OPENSPARK CLOSEEARS CLOSESPARK
|
|
|
158 %nonassoc HIGHPREC
|
|
|
159 %nonassoc UNARYPREC
|
|
|
160 %nonassoc LOWPREC
|
|
|
161 /* AIS: I reversed this precedence, to sort out the near-ambiguity.
|
|
|
162 UNARYPREC and LOWPREC are to give the C-INTERCAL meaning of a statement
|
|
|
163 precedence above its CLC-INTERCAL meaning. */
|
|
|
164
|
|
|
165 %% /* beginning of rules section */
|
|
|
166
|
|
|
167 /* A program description consists of a sequence of statements */
|
|
|
168 program : /* EMPTY */
|
|
|
169 | program command
|
|
|
170 ;
|
|
|
171
|
|
|
172 /*
|
|
|
173 * Each command consists of an optional label, followed by a preamble,
|
|
|
174 * followed by an optional probability, followed by the statement body.
|
|
|
175 * Negative exechance values indicate initial abstentions, and will be
|
|
|
176 * made positive before code is emitted.
|
|
|
177 * AIS: An exechance above 100 indicates a MAYBE situation (e.g. 4545
|
|
|
178 * means MAYBE DO %45 ...). This means %0 should be illegal. I modified
|
|
|
179 * all these to allow for MAYBE.
|
|
|
180 */
|
|
|
181 command : please mtperform
|
|
|
182 {$2->label = 0; $2->exechance = $1 * 100;}
|
|
|
183 | please OHOHSEVEN mtperform
|
|
|
184 {$3->label = 0; $3->exechance = $1 * $2;}
|
|
|
185 | LABEL please mtperform
|
|
|
186 {checklabel($1); $3->label = $1; $3->exechance = $2 * 100;}
|
|
|
187 | LABEL please OHOHSEVEN mtperform
|
|
|
188 {checklabel($1); $4->label = $1; $4->exechance = $2 * $3;}
|
|
|
189 | error
|
|
|
190 {/* AIS: catch errors which occur after the end of a statement
|
|
|
191 (highly likely when comments are being written, as the
|
|
|
192 start of them will be parsed as an UNKNOWN) */
|
|
|
193 yyerrok; yyclearin; cacsofar=0;
|
|
|
194 if(prevtuple) {prevtuple->type=SPLATTERED; splat(0);}
|
|
|
195 else splat(1); /* this is the first statement */
|
|
|
196 }
|
|
|
197 ;
|
|
|
198 /*
|
|
|
199 * AIS: added for the ONCE/AGAIN qualifiers. It copies a pointer to the tuple,
|
|
|
200 * so command will set the values in the original tuple via the copy.
|
|
|
201 * I also added prevtuple so that after-command splattering works.
|
|
|
202 */
|
|
|
203
|
|
|
204 mtperform : preproc
|
|
|
205 {$1->onceagainflag = onceagain_NORMAL; prevtuple = $$ = $1;}
|
|
|
206 | preproc ONCE
|
|
|
207 {NEWFANGLED {$1->onceagainflag = onceagain_ONCE;
|
|
|
208 prevtuple = $$ = $1;}}
|
|
|
209 | preproc AGAIN
|
|
|
210 {NEWFANGLED {$1->onceagainflag = onceagain_AGAIN;
|
|
|
211 prevtuple = $$ = $1;}}
|
|
|
212
|
|
|
213 /* AIS: Either we do a simple 'perform', or preprocessing is needed.
|
|
|
214 I wrote all of this. The way the preprocessor works is to add a whole
|
|
|
215 load of new tuples. The tuples are written in the correct order,
|
|
|
216 except for where one of the commands referenced in the preproc is
|
|
|
217 needed; then one command from near the start is written, and swapped
|
|
|
218 into place using tupleswap. ppinit must also be called giving the
|
|
|
219 number of tuples at the end, to sort out each of the tuples. Note
|
|
|
220 that preprocs can't be nested (so no DO a WHILE b WHILE c), and that
|
|
|
221 lineuid can be used to create unreplicable numbers. preproc must also
|
|
|
222 be set by hand on all commands that you want to be immune to ABSTAIN,
|
|
|
223 etc., from outside the preproc, and $$ is set to the command that
|
|
|
224 gets the line number and can be NEXTED to and from. */
|
|
|
225
|
|
|
226 preproc : perform {$$ = $1;} /* the simple case */
|
|
|
227 | perform WHILE perform
|
|
|
228 {
|
|
|
229 if(!multithread) ick_lose(IE405, iyylineno, (char*)NULL);
|
|
|
230 NEWFANGLED{
|
|
|
231 /* (x) DO a WHILE b
|
|
|
232 is equivalent to
|
|
|
233 #11 (l0) DO REINSTATE (l3) <weave on>
|
|
|
234 #10 (l1) DO COME FROM (l2) AGAIN
|
|
|
235 #9 DO b
|
|
|
236 #8 DO COME FROM (l0)
|
|
|
237 #7 DO NOTHING
|
|
|
238 #6 DO NOTHING
|
|
|
239 #5 (l2) DO NOTHING
|
|
|
240 #4 DO GIVE UP
|
|
|
241 #3 DO COME FROM (l0)
|
|
|
242 #2 (x) DO a
|
|
|
243 #1 (l3) DON'T ABSTAIN FROM (l1) AGAIN <weave off> */
|
|
|
244 tuple* temptuple;
|
|
|
245 TARGET(temptuple, COME_FROM, lineuid+2);
|
|
|
246 temptuple->label=lineuid+1; temptuple->preproc=1; /* #10 */
|
|
|
247 TARGET(temptuple, COME_FROM, lineuid+0); temptuple->preproc=1; /* #8 */
|
|
|
248 ACTION(temptuple, PREPROC, 0); temptuple->preproc=1; /* #7 */
|
|
|
249 ACTION(temptuple, PREPROC, 0); temptuple->preproc=1; /* #6 */
|
|
|
250 ACTION(temptuple, PREPROC, 0);
|
|
|
251 temptuple->label=lineuid+2; temptuple->preproc=1; /* #5 */
|
|
|
252 ACTION(temptuple, GIVE_UP, 0); temptuple->preproc=1; /* #4 */
|
|
|
253 TARGET(temptuple, COME_FROM, lineuid+0); temptuple->preproc=1; /* #3 */
|
|
|
254 TARGET(temptuple, REINSTATE, lineuid+3); temptuple->setweave=1;
|
|
|
255 temptuple->label=lineuid+0; temptuple->preproc=1; /* #11 */
|
|
|
256 TARGET(temptuple, ABSTAIN, lineuid+1); temptuple->label=lineuid+3; /* #1 */
|
|
|
257 temptuple->preproc=1; temptuple->setweave=-1; temptuple->exechance=-100;
|
|
|
258 politesse += 3; /* Keep the politeness checker happy */
|
|
|
259 ppinit(11); tupleswap(10,9); tupleswap(11,2); lineuid+=4; /* #2, #9 */
|
|
|
260 tuples[ick_lineno-10].onceagainflag=onceagain_AGAIN;
|
|
|
261 tuples[ick_lineno-1].onceagainflag=onceagain_AGAIN;
|
|
|
262 $$=&(tuples[ick_lineno-2]);
|
|
|
263 }}
|
|
|
264
|
|
|
265 /* There are two (AIS: now four) forms of preamble returned by the lexer */
|
|
|
266 please : DO {GETLINENO; $$ = 1;}
|
|
|
267 | DO NOT {GETLINENO; $$ = -1;}
|
|
|
268 | MAYBE {NEWFANGLED {GETLINENO; $$ = 101;}}
|
|
|
269 | MAYBE NOT {NEWFANGLED {GETLINENO; $$ = -101;}}
|
|
|
270 ;
|
|
|
271
|
|
|
272 /* Here's how to parse statement bodies */
|
|
|
273 perform : lvalue GETS expr {ACTION($$, GETS, cons(GETS,$1,$3));}
|
|
|
274 | ick_array GETS byexpr {ACTION($$, RESIZE, cons(RESIZE,$1,$3));}
|
|
|
275 | notanlvalue GETS expr %prec LOWPREC
|
|
|
276 {/* AIS: This is for variableconstants, and an error otherwise.*/
|
|
|
277 if(variableconstants) ACTION($$, GETS, cons(GETS,$1,$3))
|
|
|
278 else {yyerrok; yyclearin; $$=splat(1);}}
|
|
|
279 | LABEL NEXT {TARGET($$, NEXT, $1);}
|
|
|
280 | FORGET expr {ACTION($$, FORGET, $2);}
|
|
|
281 | RESUME expr {ACTION($$, RESUME, $2);}
|
|
|
282 | STASH varlist {ACTION($$, STASH, rlist);}
|
|
|
283 | RETRIEVE varlist {ACTION($$, RETRIEVE, rlist);}
|
|
|
284 | IGNORE varlist {ACTION($$, IGNORE, rlist);}
|
|
|
285 | REMEMBER varlist {ACTION($$, REMEMBER, rlist);}
|
|
|
286 | ABSTAIN FROM LABEL {stbeginline=0; TARGET($$, ABSTAIN, $3);}
|
|
|
287 | ABSTAIN FROM gerunds {ACTION($$, DISABLE, rlist);}
|
|
|
288 | ABSTAIN expr FROM LABEL {/* AIS */ NEWFANGLED {stbeginline=0; ACTARGET($$, FROM, $2, $4);}}
|
|
|
289 | ABSTAIN expr FROM gerunds {/* AIS */ NEWFANGLED {$$ = newtuple(); $$->type = MANYFROM; $$->ick_lineno = thisline; \
|
|
|
290 {node* tempnode=newnode(); $$->u.node = tempnode; tempnode->lval=$2; tempnode->rval=rlist; tempnode->opcode=MANYFROM;}}}
|
|
|
291 | REINSTATE LABEL {stbeginline=0; TARGET($$, REINSTATE, $2);}
|
|
|
292 | REINSTATE gerunds {ACTION($$, ENABLE, rlist);}
|
|
|
293 | WRITE_IN inlist {ACTION($$, WRITE_IN, $2);}
|
|
|
294 | READ_OUT outlist {ACTION($$, READ_OUT, $2);}
|
|
|
295 | PIN scalar2s {ACTION($$, PIN, $2);}
|
|
|
296 | GIVE_UP {ACTION($$, GIVE_UP, 0);}
|
|
|
297 | GO_AHEAD {/* AIS */ NEWFANGLED {ACTION($$, GO_AHEAD, 0);}}
|
|
|
298 | GO_BACK {/* AIS */ NEWFANGLED {ACTION($$, GO_BACK, 0);}}
|
|
|
299 | TRY_AGAIN {/* AIS */ NEWFANGLED {ACTION($$,TRY_AGAIN,0);}}
|
|
|
300 | COME_FROM {/* AIS: Modified */ NEWFANGLED {TARGET($$,COME_FROM,$1);}}
|
|
|
301 | COMPUCOME gerunds {/* AIS: COME FROM gerund */
|
|
|
302 NEWFANGLED{ACTION($$,GERUCOME,rlist);
|
|
|
303 compucomesused=1; gerucomesused=1;}}
|
|
|
304 | COMPUCOME expr {/* AIS */NEWFANGLED {ACTION($$,COMPUCOME,$2);
|
|
|
305 compucomesused=1;}}
|
|
|
306 /* AIS: NEXT FROM works along the same lines as COME FROM */
|
|
|
307 | NEXTFROMLABEL {NEWFANGLED {TARGET($$,NEXTFROMLABEL,$1);}
|
|
|
308 nextfromsused=1;}
|
|
|
309 | NEXTFROMEXPR gerunds{NEWFANGLED{ACTION($$,NEXTFROMGERUND,rlist);
|
|
|
310 compucomesused=1; gerucomesused=1;}
|
|
|
311 nextfromsused=1;}
|
|
|
312 | NEXTFROMEXPR expr {NEWFANGLED {ACTION($$,NEXTFROMEXPR,$2);
|
|
|
313 compucomesused=1; nextfromsused=1;}}
|
|
|
314 /* AIS: CREATE takes an 'unknown statement' as a template */
|
|
|
315 | CREATE unknownstatement {NEWFANGLED{ACTARGET($$,CREATE,$2,$1); cacsofar=0;}}
|
|
|
316 | COMPUCREATE expr unknownsif {NEWFANGLED{ACTION($$,COMPUCREATE,
|
|
|
317 cons(INTERSECTION,$2,$3)); cacsofar=0;}}
|
|
|
318 /* AIS: or an unknown expression */
|
|
|
319 | CREATE unop {NEWFANGLED{ACTARGET($$,CREATE,$2,$1);
|
|
|
320 cacsofar=0;}}
|
|
|
321 | COMPUCREATE unambig unop
|
|
|
322 {NEWFANGLED{ACTION($$,COMPUCREATE,
|
|
|
323 cons(INTERSECTION,$2,$3)); cacsofar=0;}}
|
|
|
324 /* AIS: Just-in-case compilation of unknown statements */
|
|
|
325 | unknownstatement {NEWFANGLED {ACTION($$,UNKNOWN,$1); cacsofar=0;}}
|
|
|
326 /* AIS: Added the yyerrok */
|
|
|
327 | BADCHAR {yyclearin; yyerrok; $$ = splat(1); cacsofar=0;}
|
|
|
328 | error {yyclearin; yyerrok; $$ = splat(1); cacsofar=0;}
|
|
|
329 ;
|
|
|
330
|
|
|
331 /* AIS: Unknown statements. The rule here is that we can't have two non-ID
|
|
|
332 unknowns in a row, but two IDs in a row are acceptable. */
|
|
|
333 unknownstatement : unknownatom {$$ = $1; intern(ick_TWOSPOT,cacsofar+++1601);}
|
|
|
334 | unknownsin unknownatom {$$=cons(INTERSECTION,$1,$2);
|
|
|
335 intern(ick_TWOSPOT,cacsofar+++1601);}
|
|
|
336 | unknownsin {$$ = $1;}
|
|
|
337 ;
|
|
|
338
|
|
|
339 unknownsif : unknownaid {$$ = $1;}
|
|
|
340 | unknownaid unknownstatement {$$=cons(INTERSECTION,$1,$2);}
|
|
|
341
|
|
|
342 unknownsin : unknownaid {$$ = $1;}
|
|
|
343 | unknownstatement unknownaid {$$=cons(INTERSECTION,$1,$2);}
|
|
|
344
|
|
|
345 /* Each of the possible unknown atoms, apart from arrays and IDs, generates
|
|
|
346 operand overloading info if CREATEs or external calls are used, so that
|
|
|
347 the implied overloading of a CREATE will work. */
|
|
|
348 unknownatom : subscr {$$=cons(US_ELEM,0,$1);
|
|
|
349 if(createsused){
|
|
|
350 opoverused=1; if(!firstslat)
|
|
|
351 firstslat=$1; else
|
|
|
352 prevslat->nextslat=$1;
|
|
|
353 prevslat=$1;
|
|
|
354 $1->nextslat=0;}}
|
|
|
355 | scalar {$$=cons(US_SCALAR,0,$1);
|
|
|
356 if(createsused){
|
|
|
357 opoverused=1; if(!firstslat)
|
|
|
358 firstslat=$1; else
|
|
|
359 prevslat->nextslat=$1;
|
|
|
360 prevslat=$1;
|
|
|
361 $1->nextslat=0;}}
|
|
|
362 | notanlvalue {$$=cons(US_EXPR,0,$1);
|
|
|
363 if(createsused){
|
|
|
364 opoverused=1; if(!firstslat)
|
|
|
365 firstslat=$1; else
|
|
|
366 prevslat->nextslat=$1;
|
|
|
367 prevslat=$1;
|
|
|
368 $1->nextslat=0;}}
|
|
|
369 | ick_array {$$=cons(US_ARRVAR,0,$1);}
|
|
|
370 ;
|
|
|
371
|
|
|
372 unknownaid : UNKNOWNID {$$=newnode(); $$->opcode=US_ID; $$->constant=$1;}
|
|
|
373 ;
|
|
|
374
|
|
|
375 /* gerund lists are used by ABSTAIN and REINSTATE */
|
|
|
376 gerunds : GERUND
|
|
|
377 {rlist = np = newnode(); np->constant = $1;}
|
|
|
378 | gerunds INTERSECTION GERUND
|
|
|
379 {
|
|
|
380 np->rval = newnode();
|
|
|
381 np = np->rval;
|
|
|
382 np->constant = $3;
|
|
|
383 }
|
|
|
384 ;
|
|
|
385
|
|
|
386 /* OK, here's what a variable reference looks like */
|
|
|
387 variable: scalar | ick_array;
|
|
|
388
|
|
|
389 lvalue : scalar | subscr;
|
|
|
390
|
|
|
391 scalar2s: ick_TWOSPOT NUMBER /* AIS: for TWOSPOTs only */
|
|
|
392 {
|
|
|
393 $$ = newnode();
|
|
|
394 $$->opcode = ick_TWOSPOT;
|
|
|
395 $$->constant = intern(ick_TWOSPOT, $2);
|
|
|
396 }
|
|
|
397 scalar : ick_ONESPOT NUMBER
|
|
|
398 {
|
|
|
399 $$ = newnode();
|
|
|
400 $$->opcode = ick_ONESPOT;
|
|
|
401 $$->constant = intern(ick_ONESPOT, $2);
|
|
|
402 }
|
|
|
403 | ick_TWOSPOT NUMBER
|
|
|
404 {
|
|
|
405 $$ = newnode();
|
|
|
406 $$->opcode = ick_TWOSPOT;
|
|
|
407 $$->constant = intern(ick_TWOSPOT, $2);
|
|
|
408 }
|
|
|
409 ;
|
|
|
410
|
|
|
411 ick_array : ick_TAIL NUMBER
|
|
|
412 {
|
|
|
413 $$ = newnode();
|
|
|
414 $$->opcode = ick_TAIL;
|
|
|
415 $$->constant = intern(ick_TAIL, $2);
|
|
|
416 }
|
|
|
417 | ick_HYBRID NUMBER
|
|
|
418 {
|
|
|
419 $$ = newnode();
|
|
|
420 $$->opcode = ick_HYBRID;
|
|
|
421 $$->constant = intern(ick_HYBRID, $2);
|
|
|
422 }
|
|
|
423 ;
|
|
|
424
|
|
|
425 /* Array with unary operator is a special intermediate case; these
|
|
|
426 nodes will be rearranged when the subscript list is added */
|
|
|
427 oparray : ick_TAIL UNARY NUMBER %prec UNARYPREC
|
|
|
428 {
|
|
|
429 $$ = newnode();
|
|
|
430 $$->opcode = $2;
|
|
|
431 $$->rval = newnode();
|
|
|
432 $$->rval->opcode = ick_TAIL;
|
|
|
433 $$->rval->constant = intern(ick_TAIL, $3);
|
|
|
434 }
|
|
|
435 | ick_HYBRID UNARY NUMBER %prec UNARYPREC
|
|
|
436 {
|
|
|
437 $$ = newnode();
|
|
|
438 $$->opcode = $2;
|
|
|
439 $$->rval = newnode();
|
|
|
440 $$->rval->opcode = ick_HYBRID;
|
|
|
441 $$->rval->constant = intern(ick_HYBRID, $3);
|
|
|
442 }
|
|
|
443 ;
|
|
|
444
|
|
|
445 /* And a constant looks like this */
|
|
|
446 constant: MESH NUMBER
|
|
|
447 {
|
|
|
448 /* enforce the 16-bit constant constraint */
|
|
|
449 if ((unsigned int)$2 > ick_Max_small)
|
|
|
450 ick_lose(IE017, iyylineno, (char *)NULL);
|
|
|
451 $$ = newnode();
|
|
|
452 $$->opcode = MESH;
|
|
|
453 if(variableconstants) /* AIS */
|
|
|
454 $$->constant = intern(MESH, $2);
|
|
|
455 else
|
|
|
456 $$->constant = $2;
|
|
|
457 }
|
|
|
458 ;
|
|
|
459
|
|
|
460 /* variable lists are used in STASH, RETRIEVE, IGNORE, REMEMBER */
|
|
|
461 varlist : variable {rlist = np = $1;}
|
|
|
462 | varlist INTERSECTION variable {np = np->rval = $3;
|
|
|
463 /* newnode(); */ }
|
|
|
464 ;
|
|
|
465
|
|
|
466 /* scalars and subscript exprs are permitted in WRITE IN lists */
|
|
|
467 /* new: arrays are also permitted to allow for bitwise I/0 */
|
|
|
468 initem : scalar | subscr | ick_array;
|
|
|
469 inlist : initem INTERSECTION inlist {$$=cons(INTERSECTION,$1,$3);}
|
|
|
470 | initem {$$=cons(INTERSECTION,$1,0);}
|
|
|
471 ;
|
|
|
472
|
|
|
473 /* scalars, subscript exprs & constants are permitted in READ OUT lists */
|
|
|
474 /* new: arrays are also permitted to allow for bitwise I/0 */
|
|
|
475 outitem : scalar | subscr | constant | ick_array;
|
|
|
476 outlist : outitem INTERSECTION outlist {$$=cons(INTERSECTION,$1,$3);}
|
|
|
477 | outitem {$$=cons(INTERSECTION,$1,0);}
|
|
|
478 ;
|
|
|
479
|
|
|
480 /* Now the gnarly part -- expression syntax */
|
|
|
481
|
|
|
482 /* Support ick_array dimension assignment */
|
|
|
483 byexpr : expr BY byexpr {$$ = cons(BY, $1, $3);}
|
|
|
484 | expr {$$ = cons(BY, $1, 0);}
|
|
|
485 ;
|
|
|
486
|
|
|
487 /* Support ick_array subscripts (as lvalues) */
|
|
|
488 subscr : subscr1 {$$ = $1;}
|
|
|
489 | ick_array SUB sublist {$$ = cons(SUB, $1, $3);}
|
|
|
490 ;
|
|
|
491 subscr1 : ick_array SUB sublist1 {$$ = cons(SUB, $1, $3);}
|
|
|
492 ;
|
|
|
493 sublist : unambig sublist {$$ = cons(INTERSECTION, $1, $2);}
|
|
|
494 | unambig sublist1 {$$ = cons(INTERSECTION, $1, $2);}
|
|
|
495 ;
|
|
|
496 sublist1: subscr1 {$$ = cons(INTERSECTION, $1, 0);}
|
|
|
497 | osubscr1 {$$ = cons(INTERSECTION, $1, 0);}
|
|
|
498 | unambig %prec HIGHPREC {$$ = cons(INTERSECTION, $1, 0);}
|
|
|
499 ;
|
|
|
500
|
|
|
501 /* Unary operators with arrays act like arrays only in expressions */
|
|
|
502 osubscr : osubscr1 {$$ = $1;}
|
|
|
503 | oparray SUB sublist
|
|
|
504 {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);}
|
|
|
505 ;
|
|
|
506 osubscr1: oparray SUB sublist1
|
|
|
507 {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);}
|
|
|
508 ;
|
|
|
509
|
|
|
510 /* AIS: Unknown operators */
|
|
|
511 unop : BADCHAR {$$ = newnode(); $$->opcode = BADCHAR;
|
|
|
512 $$->constant = $1;}
|
|
|
513 ;
|
|
|
514
|
|
|
515 /* here goes the general expression syntax */
|
|
|
516 expr : unambig {$$ = $1;}
|
|
|
517 /* AIS: CLC-INTERCAL allows right-association of SELECT and MINGLE.
|
|
|
518 (Strangely, that simplifies this section somewhat.) */
|
|
|
519 | unambig SELECT expr {$$ = cons(SELECT, $1, $3);}
|
|
|
520 | unambig MINGLE expr {$$ = cons(MINGLE, $1, $3);}
|
|
|
521 | unambig unop expr {$$ = cons(UNKNOWNOP, $2,
|
|
|
522 cons(INTERSECTION, $1, $3));
|
|
|
523 if(useickec && createsused) {
|
|
|
524 if(!firstslat) firstslat=$1;
|
|
|
525 else prevslat->nextslat=$1;
|
|
|
526 $1->nextslat=$3; prevslat=$3;
|
|
|
527 $3->nextslat=0; opoverused=1;
|
|
|
528 intern(ick_TWOSPOT, 1601);
|
|
|
529 intern(ick_TWOSPOT, 1602);
|
|
|
530 intern(ick_TWOSPOT, 1603);}}
|
|
|
531 /* AIS: Operand overloading */
|
|
|
532 | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3);
|
|
|
533 opoverused=1; if(!firstslat)
|
|
|
534 firstslat=$3; else
|
|
|
535 prevslat->nextslat=$3; prevslat=$3;
|
|
|
536 $3->nextslat=0;}}
|
|
|
537 | subscr {$$ = $1;}
|
|
|
538 | osubscr {$$ = $1;}
|
|
|
539 ;
|
|
|
540
|
|
|
541 /* AIS: Any expression that isn't an lvalue */
|
|
|
542 notanlvalue:nlunambig {$$ = $1;}
|
|
|
543 | osubscr {$$ = $1;}
|
|
|
544 | unambig SELECT expr {$$ = cons(SELECT, $1, $3);}
|
|
|
545 | unambig MINGLE expr {$$ = cons(MINGLE, $1, $3);}
|
|
|
546 | unambig unop expr {$$ = cons(UNKNOWNOP, $2,
|
|
|
547 cons(INTERSECTION, $1, $3));
|
|
|
548 if(useickec && createsused) {
|
|
|
549 if(!firstslat) firstslat=$1;
|
|
|
550 else prevslat->nextslat=$1;
|
|
|
551 $1->nextslat=$3; prevslat=$3;
|
|
|
552 $3->nextslat=0; opoverused=1;
|
|
|
553 intern(ick_TWOSPOT, 1601);
|
|
|
554 intern(ick_TWOSPOT, 1602);
|
|
|
555 intern(ick_TWOSPOT, 1603);}}
|
|
|
556 | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3);
|
|
|
557 opoverused=1; if(!firstslat)
|
|
|
558 firstslat=$3; else
|
|
|
559 prevslat->nextslat=$3; prevslat=$3;
|
|
|
560 $3->nextslat=0;}}
|
|
|
561 ;
|
|
|
562
|
|
|
563 /* AIS: an expr that doesn't start with a unary operator */
|
|
|
564 limexpr : limunambig {$$ = $1;}
|
|
|
565 | limunambig SELECT expr {$$ = cons(SELECT, $1, $3);}
|
|
|
566 | limunambig MINGLE expr {$$ = cons(MINGLE, $1, $3);}
|
|
|
567 | limunambig unop expr {$$ = cons(UNKNOWNOP, $2,
|
|
|
568 cons(INTERSECTION, $1, $3));
|
|
|
569 if(useickec && createsused) {
|
|
|
570 if(!firstslat) firstslat=$1;
|
|
|
571 else prevslat->nextslat=$1;
|
|
|
572 $1->nextslat=$3; prevslat=$3;
|
|
|
573 $3->nextslat=0; opoverused=1;
|
|
|
574 intern(ick_TWOSPOT, 1601);
|
|
|
575 intern(ick_TWOSPOT, 1602);
|
|
|
576 intern(ick_TWOSPOT, 1603);}}
|
|
|
577 | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3);
|
|
|
578 opoverused=1; if(!firstslat)
|
|
|
579 firstslat=$3; else
|
|
|
580 prevslat->nextslat=$3; prevslat=$3;
|
|
|
581 $3->nextslat=0;}}
|
|
|
582 | subscr {$$ = $1;}
|
|
|
583 | osubscr {$$ = $1;}
|
|
|
584 ;
|
|
|
585
|
|
|
586
|
|
|
587 preftype: MESH {$$=MESH; } | ick_ONESPOT {$$=ick_ONESPOT;} | ick_TWOSPOT {$$=ick_TWOSPOT;};
|
|
|
588
|
|
|
589 /* AIS: unambig split into limunambig (unambigs that don't start with a
|
|
|
590 unary operator), nlunambig (unambigs that aren't lvalues),
|
|
|
591 lunambig (both), and unambig (the general case) */
|
|
|
592 lunambig: constant {$$ = $1;}
|
|
|
593 /* deal with the bizarre unary-op syntax */
|
|
|
594 | preftype UNARY NUMBER %prec UNARYPREC
|
|
|
595 {
|
|
|
596 $$ = newnode();
|
|
|
597 $$->opcode = $2;
|
|
|
598 $$->rval = newnode();
|
|
|
599 $$->rval->opcode = $1;
|
|
|
600 if($1 == MESH) {
|
|
|
601 /* enforce the 16-bit constant constraint */
|
|
|
602 if ((unsigned int)$3 > ick_Max_small)
|
|
|
603 ick_lose(IE017, iyylineno, (char *)NULL);
|
|
|
604 if(variableconstants) /* AIS, patched by JH */
|
|
|
605 $$->rval->constant = intern(MESH, $3);
|
|
|
606 else
|
|
|
607 $$->rval->constant = $3;
|
|
|
608 }
|
|
|
609 else {
|
|
|
610 $$->rval->constant = intern($1, $3);
|
|
|
611 }
|
|
|
612 }
|
|
|
613
|
|
|
614 /* Now deal with the screwy unary-op interaction with grouping */
|
|
|
615 /* AIS: Modified to allow for maintenance of the SPARK/EARS stack */
|
|
|
616 | eitherspark UNARY expr CLOSESPARK %prec UNARYPREC
|
|
|
617 {
|
|
|
618 $$ = newnode();
|
|
|
619 $$->opcode = $2;
|
|
|
620 $$->rval = $3;
|
|
|
621 DESTACKSPARKEARS;
|
|
|
622 }
|
|
|
623 | eitherears UNARY expr CLOSEEARS %prec UNARYPREC
|
|
|
624 {
|
|
|
625 $$ = newnode();
|
|
|
626 $$->opcode = $2;
|
|
|
627 $$->rval = $3;
|
|
|
628 DESTACKSPARKEARS;
|
|
|
629 }
|
|
|
630 /* AIS: limexpr, a limited expression that isn't allowed to start with a
|
|
|
631 unary operator, is used here to avoid a reduce/reduce conflict. */
|
|
|
632 | eitherspark limexpr CLOSESPARK {$$ = $2; DESTACKSPARKEARS;}
|
|
|
633 | eitherears limexpr CLOSEEARS {$$ = $2; DESTACKSPARKEARS;}
|
|
|
634 ;
|
|
|
635
|
|
|
636 limunambig: lunambig {$$ = $1;}
|
|
|
637 | scalar {$$ = $1;}
|
|
|
638 ;
|
|
|
639
|
|
|
640 nlunambig: lunambig {$$ = $1;}
|
|
|
641 | UNARY unambig %prec LOWPREC
|
|
|
642 {$$=newnode(); $$->opcode = $1; $$->rval = $2;}
|
|
|
643 ;
|
|
|
644
|
|
|
645 /* AIS: A bit of CLC-INTERCAL compatibility here.
|
|
|
646 The syntax now allows any number of unary operators before, and one inside,
|
|
|
647 an expression. In ambiguous cases like '&VV#1~#5', the & applies to the
|
|
|
648 whole expression (one operator inside is allowed, and inside takes
|
|
|
649 precedence), but the Vs apply just to the #1, because only one operator
|
|
|
650 inside is allowed. */
|
|
|
651 unambig : limunambig {$$ = $1;}
|
|
|
652 | UNARY unambig %prec LOWPREC
|
|
|
653 {$$=newnode(); $$->opcode = $1; $$->rval = $2;}
|
|
|
654 ;
|
|
|
655
|
|
|
656 eitherspark : OPENSPARK ;
|
|
|
657 | CLOSESPARK ;
|
|
|
658 ;
|
|
|
659
|
|
|
660 eitherears : OPENEARS ;
|
|
|
661 | CLOSEEARS ;
|
|
|
662 ;
|
|
|
663
|
|
|
664 %%
|
|
|
665
|
|
|
666 static tuple *splat(int gentuple)
|
|
|
667 /* try to recover from an invalid statement. */
|
|
|
668 {
|
|
|
669 tuple *sp;
|
|
|
670 int tok, i;
|
|
|
671 extern ick_bool re_send_token;
|
|
|
672
|
|
|
673 /*
|
|
|
674 * The idea
|
|
|
675 * here is to skip to the ick_next DO, PLEASE or label, then unget that token.
|
|
|
676 * which we can do with a tricky flag on the lexer (re_send_token).
|
|
|
677 */
|
|
|
678
|
|
|
679 if(re_send_token == ick_TRUE) /* By AIS */
|
|
|
680 {
|
|
|
681 /* We're still cleaning up from the previous error. */
|
|
|
682 return prevtuple;
|
|
|
683 }
|
|
|
684
|
|
|
685 /* fprintf(stderr,"attempting to splat at line %d....\n",iyylineno); */
|
|
|
686 /* AIS: Set the flag to true the first time round, false for subsequent
|
|
|
687 iterations. That way, if the error was triggered on a DO or label,
|
|
|
688 we use that token as the start of the next statement. */
|
|
|
689 for(i = 0,re_send_token = ick_TRUE;;i++,re_send_token = ick_FALSE) {
|
|
|
690 tok = lexer();
|
|
|
691 if (!tok)
|
|
|
692 {
|
|
|
693 re_send_token = ick_TRUE;
|
|
|
694 tok = ' '; /* scanner must not see a NUL */
|
|
|
695 break;
|
|
|
696 }
|
|
|
697 else if (tok == DO || tok == PLEASE || tok == LABEL
|
|
|
698 /* AIS */ || tok == MAYBE) {
|
|
|
699 re_send_token = ick_TRUE;
|
|
|
700 break;
|
|
|
701 }
|
|
|
702 }
|
|
|
703 /*
|
|
|
704 fprintf(stderr,"found %d on line %d after %d other tokens.\n",
|
|
|
705 tok,iyylineno,i);
|
|
|
706 */
|
|
|
707
|
|
|
708 /* generate a placeholder tuple for the text line */
|
|
|
709 if(gentuple /* AIS */) {TARGET(sp, SPLATTERED, 0); prevtuple=sp;}
|
|
|
710 else sp=NULL;
|
|
|
711
|
|
|
712 return(sp);
|
|
|
713 }
|
|
|
714
|
|
|
715 /* parser.y ends here */
|
