6a6604d5010d5105c94f877eb557c5751a45d56d
[p5sagit/p5-mst-13.2.git] / x2p / a2p.y
1 %{
2 /* $Header: a2p.y,v 3.0.1.1 90/03/01 10:30:08 lwall Locked $
3  *
4  *    Copyright (c) 1989, Larry Wall
5  *
6  *    You may distribute under the terms of the GNU General Public License
7  *    as specified in the README file that comes with the perl 3.0 kit.
8  *
9  * $Log:        a2p.y,v $
10  * Revision 3.0.1.1  90/03/01  10:30:08  lwall
11  * patch9: a2p didn't allow logical expressions everywhere it should
12  * 
13  * Revision 3.0  89/10/18  15:34:29  lwall
14  * 3.0 baseline
15  * 
16  */
17
18 #include "INTERN.h"
19 #include "a2p.h"
20
21 int root;
22 int begins = Nullop;
23 int ends = Nullop;
24
25 %}
26 %token BEGIN END
27 %token REGEX
28 %token SEMINEW NEWLINE COMMENT
29 %token FUN1 FUNN GRGR
30 %token PRINT PRINTF SPRINTF SPLIT
31 %token IF ELSE WHILE FOR IN
32 %token EXIT NEXT BREAK CONTINUE RET
33 %token GETLINE DO SUB GSUB MATCH
34 %token FUNCTION USERFUN DELETE
35
36 %right ASGNOP
37 %right '?' ':'
38 %left OROR
39 %left ANDAND
40 %left IN
41 %left NUMBER VAR SUBSTR INDEX
42 %left MATCHOP
43 %left RELOP '<' '>'
44 %left OR
45 %left STRING
46 %left '+' '-'
47 %left '*' '/' '%'
48 %right UMINUS
49 %left NOT
50 %right '^'
51 %left INCR DECR
52 %left FIELD VFIELD
53
54 %%
55
56 program : junk hunks
57                 { root = oper4(OPROG,$1,begins,$2,ends); }
58         ;
59
60 begin   : BEGIN '{' maybe states '}' junk
61                 { begins = oper4(OJUNK,begins,$3,$4,$6); in_begin = FALSE;
62                     $$ = Nullop; }
63         ;
64
65 end     : END '{' maybe states '}'
66                 { ends = oper3(OJUNK,ends,$3,$4); $$ = Nullop; }
67         | end NEWLINE
68                 { $$ = $1; }
69         ;
70
71 hunks   : hunks hunk junk
72                 { $$ = oper3(OHUNKS,$1,$2,$3); }
73         | /* NULL */
74                 { $$ = Nullop; }
75         ;
76
77 hunk    : patpat
78                 { $$ = oper1(OHUNK,$1); need_entire = TRUE; }
79         | patpat '{' maybe states '}'
80                 { $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); }
81         | FUNCTION USERFUN '(' arg_list ')' maybe '{' maybe states '}'
82                 { fixfargs($2,$4,0); $$ = oper5(OUSERDEF,$2,$4,$6,$8,$9); }
83         | '{' maybe states '}'
84                 { $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); }
85         | begin
86         | end
87         ;
88
89 arg_list: expr_list
90                 { $$ = rememberargs($$); }
91         ;
92
93 patpat  : cond
94                 { $$ = oper1(OPAT,$1); }
95         | cond ',' cond
96                 { $$ = oper2(ORANGE,$1,$3); }
97         ;
98
99 cond    : expr
100         | match
101         | rel
102         | compound_cond
103         ;
104
105 compound_cond
106         : '(' compound_cond ')'
107                 { $$ = oper1(OCPAREN,$2); }
108         | cond ANDAND maybe cond
109                 { $$ = oper3(OCANDAND,$1,$3,$4); }
110         | cond OROR maybe cond
111                 { $$ = oper3(OCOROR,$1,$3,$4); }
112         | NOT cond
113                 { $$ = oper1(OCNOT,$2); }
114         ;
115
116 rel     : expr RELOP expr
117                 { $$ = oper3(ORELOP,$2,$1,$3); }
118         | expr '>' expr
119                 { $$ = oper3(ORELOP,string(">",1),$1,$3); }
120         | expr '<' expr
121                 { $$ = oper3(ORELOP,string("<",1),$1,$3); }
122         | '(' rel ')'
123                 { $$ = oper1(ORPAREN,$2); }
124         ;
125
126 match   : expr MATCHOP expr
127                 { $$ = oper3(OMATCHOP,$2,$1,$3); }
128         | expr MATCHOP REGEX
129                 { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); }
130         | REGEX         %prec MATCHOP
131                 { $$ = oper1(OREGEX,$1); }
132         | '(' match ')'
133                 { $$ = oper1(OMPAREN,$2); }
134         ;
135
136 expr    : term
137                 { $$ = $1; }
138         | expr term
139                 { $$ = oper2(OCONCAT,$1,$2); }
140         | variable ASGNOP expr
141                 { $$ = oper3(OASSIGN,$2,$1,$3);
142                         if ((ops[$1].ival & 255) == OFLD)
143                             lval_field = TRUE;
144                         if ((ops[$1].ival & 255) == OVFLD)
145                             lval_field = TRUE;
146                 }
147         ;
148
149 term    : variable
150                 { $$ = $1; }
151         | NUMBER
152                 { $$ = oper1(ONUM,$1); }
153         | STRING
154                 { $$ = oper1(OSTR,$1); }
155         | term '+' term
156                 { $$ = oper2(OADD,$1,$3); }
157         | term '-' term
158                 { $$ = oper2(OSUBTRACT,$1,$3); }
159         | term '*' term
160                 { $$ = oper2(OMULT,$1,$3); }
161         | term '/' term
162                 { $$ = oper2(ODIV,$1,$3); }
163         | term '%' term
164                 { $$ = oper2(OMOD,$1,$3); }
165         | term '^' term
166                 { $$ = oper2(OPOW,$1,$3); }
167         | term IN VAR
168                 { $$ = oper2(ODEFINED,aryrefarg($3),$1); }
169         | term '?' term ':' term
170                 { $$ = oper2(OCOND,$1,$3,$5); }
171         | variable INCR
172                 { $$ = oper1(OPOSTINCR,$1); }
173         | variable DECR
174                 { $$ = oper1(OPOSTDECR,$1); }
175         | INCR variable
176                 { $$ = oper1(OPREINCR,$2); }
177         | DECR variable
178                 { $$ = oper1(OPREDECR,$2); }
179         | '-' term %prec UMINUS
180                 { $$ = oper1(OUMINUS,$2); }
181         | '+' term %prec UMINUS
182                 { $$ = oper1(OUPLUS,$2); }
183         | '(' cond ')'
184                 { $$ = oper1(OPAREN,$2); }
185         | GETLINE
186                 { $$ = oper0(OGETLINE); }
187         | GETLINE VAR
188                 { $$ = oper1(OGETLINE,$2); }
189         | GETLINE '<' expr
190                 { $$ = oper3(OGETLINE,Nullop,string("<",1),$3);
191                     if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
192         | GETLINE VAR '<' expr
193                 { $$ = oper3(OGETLINE,$2,string("<",1),$4);
194                     if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
195         | term 'p' GETLINE
196                 { $$ = oper3(OGETLINE,Nullop,string("|",1),$1);
197                     if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
198         | term 'p' GETLINE VAR
199                 { $$ = oper3(OGETLINE,$4,string("|",1),$1);
200                     if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
201         | FUN1
202                 { $$ = oper0($1); need_entire = do_chop = TRUE; }
203         | FUN1 '(' ')'
204                 { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; }
205         | FUN1 '(' expr ')'
206                 { $$ = oper1($1,$3); }
207         | FUNN '(' expr_list ')'
208                 { $$ = oper1($1,$3); }
209         | USERFUN '(' expr_list ')'
210                 { $$ = oper2(OUSERFUN,$1,$3); }
211         | SPRINTF expr_list
212                 { $$ = oper1(OSPRINTF,$2); }
213         | SUBSTR '(' expr ',' expr ',' expr ')'
214                 { $$ = oper3(OSUBSTR,$3,$5,$7); }
215         | SUBSTR '(' expr ',' expr ')'
216                 { $$ = oper2(OSUBSTR,$3,$5); }
217         | SPLIT '(' expr ',' VAR ',' expr ')'
218                 { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
219         | SPLIT '(' expr ',' VAR ')'
220                 { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
221         | INDEX '(' expr ',' expr ')'
222                 { $$ = oper2(OINDEX,$3,$5); }
223         | MATCH '(' expr ',' REGEX ')'
224                 { $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); }
225         | MATCH '(' expr ',' expr ')'
226                 { $$ = oper2(OMATCH,$3,$5); }
227         | SUB '(' expr ',' expr ')'
228                 { $$ = oper2(OSUB,$3,$5); }
229         | SUB '(' REGEX ',' expr ')'
230                 { $$ = oper2(OSUB,oper1(OREGEX,$3),$5); }
231         | GSUB '(' expr ',' expr ')'
232                 { $$ = oper2(OGSUB,$3,$5); }
233         | GSUB '(' REGEX ',' expr ')'
234                 { $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); }
235         | SUB '(' expr ',' expr ',' expr ')'
236                 { $$ = oper3(OSUB,$3,$5,$7); }
237         | SUB '(' REGEX ',' expr ',' expr ')'
238                 { $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); }
239         | GSUB '(' expr ',' expr ',' expr ')'
240                 { $$ = oper3(OGSUB,$3,$5,$7); }
241         | GSUB '(' REGEX ',' expr ',' expr ')'
242                 { $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); }
243         ;
244
245 variable: VAR
246                 { $$ = oper1(OVAR,$1); }
247         | VAR '[' expr_list ']'
248                 { $$ = oper2(OVAR,aryrefarg($1),$3); }
249         | FIELD
250                 { $$ = oper1(OFLD,$1); }
251         | VFIELD term
252                 { $$ = oper1(OVFLD,$2); }
253         ;
254
255 expr_list
256         : expr
257         | clist
258         | /* NULL */
259                 { $$ = Nullop; }
260         ;
261
262 clist   : expr ',' maybe expr
263                 { $$ = oper3(OCOMMA,$1,$3,$4); }
264         | clist ',' maybe expr
265                 { $$ = oper3(OCOMMA,$1,$3,$4); }
266         | '(' clist ')'         /* these parens are invisible */
267                 { $$ = $2; }
268         ;
269
270 junk    : junk hunksep
271                 { $$ = oper2(OJUNK,$1,$2); }
272         | /* NULL */
273                 { $$ = Nullop; }
274         ;
275
276 hunksep : ';'
277                 { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
278         | SEMINEW
279                 { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
280         | NEWLINE
281                 { $$ = oper0(ONEWLINE); }
282         | COMMENT
283                 { $$ = oper1(OCOMMENT,$1); }
284         ;
285
286 maybe   : maybe nlstuff
287                 { $$ = oper2(OJUNK,$1,$2); }
288         | /* NULL */
289                 { $$ = Nullop; }
290         ;
291
292 nlstuff : NEWLINE
293                 { $$ = oper0(ONEWLINE); }
294         | COMMENT
295                 { $$ = oper1(OCOMMENT,$1); }
296         ;
297
298 separator
299         : ';' maybe
300                 { $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); }
301         | SEMINEW maybe
302                 { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
303         | NEWLINE maybe
304                 { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
305         | COMMENT maybe
306                 { $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); }
307         ;
308
309 states  : states statement
310                 { $$ = oper2(OSTATES,$1,$2); }
311         | /* NULL */
312                 { $$ = Nullop; }
313         ;
314
315 statement
316         : simple separator maybe
317                 { $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); }
318         | ';' maybe
319                 { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); }
320         | SEMINEW maybe
321                 { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); }
322         | compound
323         ;
324
325 simpnull: simple
326         | /* NULL */
327                 { $$ = Nullop; }
328         ;
329
330 simple
331         : expr
332         | PRINT expr_list redir expr
333                 { $$ = oper3(OPRINT,$2,$3,$4);
334                     do_opens = TRUE;
335                     saw_ORS = saw_OFS = TRUE;
336                     if (!$2) need_entire = TRUE;
337                     if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
338         | PRINT expr_list
339                 { $$ = oper1(OPRINT,$2);
340                     if (!$2) need_entire = TRUE;
341                     saw_ORS = saw_OFS = TRUE;
342                 }
343         | PRINTF expr_list redir expr
344                 { $$ = oper3(OPRINTF,$2,$3,$4);
345                     do_opens = TRUE;
346                     if (!$2) need_entire = TRUE;
347                     if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
348         | PRINTF expr_list
349                 { $$ = oper1(OPRINTF,$2);
350                     if (!$2) need_entire = TRUE;
351                 }
352         | BREAK
353                 { $$ = oper0(OBREAK); }
354         | NEXT
355                 { $$ = oper0(ONEXT); }
356         | EXIT
357                 { $$ = oper0(OEXIT); }
358         | EXIT expr
359                 { $$ = oper1(OEXIT,$2); }
360         | CONTINUE
361                 { $$ = oper0(OCONTINUE); }
362         | RET
363                 { $$ = oper0(ORETURN); }
364         | RET expr
365                 { $$ = oper1(ORETURN,$2); }
366         | DELETE VAR '[' expr ']'
367                 { $$ = oper2(ODELETE,aryrefarg($2),$4); }
368         ;
369
370 redir   : '>'   %prec FIELD
371                 { $$ = oper1(OREDIR,$1); }
372         | GRGR
373                 { $$ = oper1(OREDIR,string(">>",2)); }
374         | '|'
375                 { $$ = oper1(OREDIR,string("|",1)); }
376         ;
377
378 compound
379         : IF '(' cond ')' maybe statement
380                 { $$ = oper2(OIF,$3,bl($6,$5)); }
381         | IF '(' cond ')' maybe statement ELSE maybe statement
382                 { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); }
383         | WHILE '(' cond ')' maybe statement
384                 { $$ = oper2(OWHILE,$3,bl($6,$5)); }
385         | DO maybe statement WHILE '(' cond ')'
386                 { $$ = oper2(ODO,bl($3,$2),$6); }
387         | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement
388                 { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); }
389         | FOR '(' simpnull ';'  ';' simpnull ')' maybe statement
390                 { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); }
391         | FOR '(' expr ')' maybe statement
392                 { $$ = oper2(OFORIN,$3,bl($6,$5)); }
393         | '{' maybe states '}' maybe
394                 { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); }
395         ;
396
397 %%
398 #include "a2py.c"