1%token _LANGLE_t
2%token _LANGLE_EQUALS_t
3%token _EQUALS_t
4%token _RANGLE_t
5%token _RANGLE_EQUALS_t
6%token _BAR_t
7%token _BARBAR_t
8%token _SEMIC_t
9%token _COLON_t
10%token _BANG_t
11%token _BANG_EQUALS_t
12%token _QUESTION_EQUALS_t
13%token _LPAREN_t
14%token _RPAREN_t
15%token _LBRACKET_t
16%token _RBRACKET_t
17%token _LBRACE_t
18%token _RBRACE_t
19%token _AMPER_t
20%token _AMPERAMPER_t
21%token _PLUS_EQUALS_t
22%token ACTIONS_t
23%token BIND_t
24%token BREAK_t
25%token CASE_t
26%token CONTINUE_t
27%token DEFAULT_t
28%token ELSE_t
29%token EXISTING_t
30%token FOR_t
31%token IF_t
32%token IGNORE_t
33%token IN_t
34%token INCLUDE_t
35%token JUMPTOEOF_t
36%token LOCAL_t
37%token MAXLINE_t
38%token ON_t
39%token PIECEMEAL_t
40%token QUIETLY_t
41%token RETURN_t
42%token RULE_t
43%token SWITCH_t
44%token TOGETHER_t
45%token UPDATED_t
46%token WHILE_t
47/*
48 * Copyright 1993-2002 Christopher Seiwald and Perforce Software, Inc.
49 *
50 * This file is part of Jam - see jam.c for Copyright information.
51 */
52
53/*
54 * jamgram.yy - jam grammar
55 *
56 * 04/13/94 (seiwald) - added shorthand L0 for null list pointer
57 * 06/01/94 (seiwald) - new 'actions existing' does existing sources
58 * 08/23/94 (seiwald) - Support for '+=' (append to variable)
59 * 08/31/94 (seiwald) - Allow ?= as alias for "default =".
60 * 09/15/94 (seiwald) - if conditionals take only single arguments, so
61 *			that 'if foo == bar' gives syntax error (use =).
62 * 02/11/95 (seiwald) - when scanning arguments to rules, only treat
63 *			punctuation keywords as keywords.  All arg lists
64 *			are terminated with punctuation keywords.
65 * 09/11/00 (seiwald) - Support for function calls; rules return LIST *.
66 * 01/22/01 (seiwald) - replace evaluate_if() with compile_eval()
67 * 01/24/01 (seiwald) - 'while' statement
68 * 03/23/01 (seiwald) - "[ on target rule ]" support
69 * 02/27/02 (seiwald) - un-break "expr : arg in list" syntax
70 * 03/02/02 (seiwald) - rules can be invoked via variable names
71 * 03/12/02 (seiwald) - set YYMAXDEPTH for big, right-recursive rules
72 * 02/28/02 (seiwald) - merge EXEC_xxx flags in with RULE_xxx
73 * 06/21/02 (seiwald) - support for named parameters
74 * 10/22/02 (seiwald) - working return/break/continue statements
75 */
76
77%token ARG STRING
78
79%left _BARBAR_t _BAR_t
80%left _AMPERAMPER_t _AMPER_t
81%left _EQUALS_t _BANG_EQUALS_t IN_t
82%left _LANGLE_t _LANGLE_EQUALS_t _RANGLE_t _RANGLE_EQUALS_t
83%left _BANG_t
84
85%{
86#include "jam.h"
87
88#include "lists.h"
89#include "variable.h"
90#include "parse.h"
91#include "scan.h"
92#include "compile.h"
93#include "newstr.h"
94#include "rules.h"
95
96# define YYMAXDEPTH 10000	/* for OSF and other less endowed yaccs */
97
98# define F0 (LIST *(*)(PARSE *, LOL *, int *))0
99# define P0 (PARSE *)0
100# define S0 (char *)0
101
102# define pappend( l,r )    	parse_make( compile_append,l,r,P0,S0,S0,0 )
103# define pbreak( l,f )     	parse_make( compile_break,l,P0,P0,S0,S0,f )
104# define peval( c,l,r )		parse_make( compile_eval,l,r,P0,S0,S0,c )
105# define pfor( s,l,r )    	parse_make( compile_foreach,l,r,P0,s,S0,0 )
106# define pif( l,r,t )	  	parse_make( compile_if,l,r,t,S0,S0,0 )
107# define pincl( l )       	parse_make( compile_include,l,P0,P0,S0,S0,0 )
108# define plist( s )	  	parse_make( compile_list,P0,P0,P0,s,S0,0 )
109# define plocal( l,r,t )  	parse_make( compile_local,l,r,t,S0,S0,0 )
110# define pnull()	  	parse_make( compile_null,P0,P0,P0,S0,S0,0 )
111# define pon( l,r )	  	parse_make( compile_on,l,r,P0,S0,S0,0 )
112# define prule( a,p )     	parse_make( compile_rule,a,p,P0,S0,S0,0 )
113# define prules( l,r )	  	parse_make( compile_rules,l,r,P0,S0,S0,0 )
114# define pset( l,r,a ) 	  	parse_make( compile_set,l,r,P0,S0,S0,a )
115# define pset1( l,r,t,a )	parse_make( compile_settings,l,r,t,S0,S0,a )
116# define psetc( s,l,r )     	parse_make( compile_setcomp,l,r,P0,s,S0,0 )
117# define psete( s,l,s1,f ) 	parse_make( compile_setexec,l,P0,P0,s,s1,f )
118# define pswitch( l,r )   	parse_make( compile_switch,l,r,P0,S0,S0,0 )
119# define pwhile( l,r )   	parse_make( compile_while,l,r,P0,S0,S0,0 )
120
121# define pnode( l,r )    	parse_make( F0,l,r,P0,S0,S0,0 )
122# define psnode( s,l )     	parse_make( F0,l,P0,P0,s,S0,0 )
123
124%}
125
126%%
127
128run	: /* empty */
129		/* do nothing */
130	| rules
131		{ parse_save( $1.parse ); }
132	;
133
134/*
135 * block - zero or more rules
136 * rules - one or more rules
137 * rule - any one of jam's rules
138 * right-recursive so rules execute in order.
139 */
140
141block	: /* empty */
142		{ $$.parse = pnull(); }
143	| rules
144		{ $$.parse = $1.parse; }
145	;
146
147rules	: rule
148		{ $$.parse = $1.parse; }
149	| rule rules
150		{ $$.parse = prules( $1.parse, $2.parse ); }
151	| LOCAL_t list _SEMIC_t block
152		{ $$.parse = plocal( $2.parse, pnull(), $4.parse ); }
153	| LOCAL_t list _EQUALS_t list _SEMIC_t block
154		{ $$.parse = plocal( $2.parse, $4.parse, $6.parse ); }
155	;
156
157rule	: _LBRACE_t block _RBRACE_t
158		{ $$.parse = $2.parse; }
159	| INCLUDE_t list _SEMIC_t
160		{ $$.parse = pincl( $2.parse ); }
161	| JUMPTOEOF_t list _SEMIC_t
162		{ $$.parse = pbreak( $2.parse, JMP_EOF ); }
163	| arg lol _SEMIC_t
164		{ $$.parse = prule( $1.parse, $2.parse ); }
165	| arg assign list _SEMIC_t
166		{ $$.parse = pset( $1.parse, $3.parse, $2.number ); }
167	| arg ON_t list assign list _SEMIC_t
168		{ $$.parse = pset1( $1.parse, $3.parse, $5.parse, $4.number ); }
169	| BREAK_t list _SEMIC_t
170		{ $$.parse = pbreak( $2.parse, JMP_BREAK ); }
171	| CONTINUE_t list _SEMIC_t
172		{ $$.parse = pbreak( $2.parse, JMP_CONTINUE ); }
173	| RETURN_t list _SEMIC_t
174		{ $$.parse = pbreak( $2.parse, JMP_RETURN ); }
175	| FOR_t ARG IN_t list _LBRACE_t block _RBRACE_t
176		{ $$.parse = pfor( $2.string, $4.parse, $6.parse ); }
177	| SWITCH_t list _LBRACE_t cases _RBRACE_t
178		{ $$.parse = pswitch( $2.parse, $4.parse ); }
179	| IF_t expr _LBRACE_t block _RBRACE_t
180		{ $$.parse = pif( $2.parse, $4.parse, pnull() ); }
181	| IF_t expr _LBRACE_t block _RBRACE_t ELSE_t rule
182		{ $$.parse = pif( $2.parse, $4.parse, $7.parse ); }
183	| WHILE_t expr _LBRACE_t block _RBRACE_t
184		{ $$.parse = pwhile( $2.parse, $4.parse ); }
185	| RULE_t ARG params _LBRACE_t block _RBRACE_t
186		{ $$.parse = psetc( $2.string, $3.parse, $5.parse ); }
187	| ON_t arg rule
188		{ $$.parse = pon( $2.parse, $3.parse ); }
189	| ACTIONS_t eflags ARG bindlist _LBRACE_t
190		{ yymode( SCAN_STRING ); }
191	  STRING
192		{ yymode( SCAN_NORMAL ); }
193	  _RBRACE_t
194		{ $$.parse = psete( $3.string,$4.parse,$7.string,$2.number ); }
195	;
196
197/*
198 * assign - = or +=
199 */
200
201assign	: _EQUALS_t
202		{ $$.number = VAR_SET; }
203	| _PLUS_EQUALS_t
204		{ $$.number = VAR_APPEND; }
205	| _QUESTION_EQUALS_t
206		{ $$.number = VAR_DEFAULT; }
207	| DEFAULT_t _EQUALS_t
208		{ $$.number = VAR_DEFAULT; }
209	;
210
211/*
212 * expr - an expression for if
213 */
214
215expr	: arg
216		{ $$.parse = peval( EXPR_EXISTS, $1.parse, pnull() ); }
217	| expr _EQUALS_t expr
218		{ $$.parse = peval( EXPR_EQUALS, $1.parse, $3.parse ); }
219	| expr _BANG_EQUALS_t expr
220		{ $$.parse = peval( EXPR_NOTEQ, $1.parse, $3.parse ); }
221	| expr _LANGLE_t expr
222		{ $$.parse = peval( EXPR_LESS, $1.parse, $3.parse ); }
223	| expr _LANGLE_EQUALS_t expr
224		{ $$.parse = peval( EXPR_LESSEQ, $1.parse, $3.parse ); }
225	| expr _RANGLE_t expr
226		{ $$.parse = peval( EXPR_MORE, $1.parse, $3.parse ); }
227	| expr _RANGLE_EQUALS_t expr
228		{ $$.parse = peval( EXPR_MOREEQ, $1.parse, $3.parse ); }
229	| expr _AMPER_t expr
230		{ $$.parse = peval( EXPR_AND, $1.parse, $3.parse ); }
231	| expr _AMPERAMPER_t expr
232		{ $$.parse = peval( EXPR_AND, $1.parse, $3.parse ); }
233	| expr _BAR_t expr
234		{ $$.parse = peval( EXPR_OR, $1.parse, $3.parse ); }
235	| expr _BARBAR_t expr
236		{ $$.parse = peval( EXPR_OR, $1.parse, $3.parse ); }
237	| arg IN_t list
238		{ $$.parse = peval( EXPR_IN, $1.parse, $3.parse ); }
239	| _BANG_t expr
240		{ $$.parse = peval( EXPR_NOT, $2.parse, pnull() ); }
241	| _LPAREN_t expr _RPAREN_t
242		{ $$.parse = $2.parse; }
243	;
244
245/*
246 * cases - action elements inside a 'switch'
247 * case - a single action element inside a 'switch'
248 * right-recursive rule so cases can be examined in order.
249 */
250
251cases	: /* empty */
252		{ $$.parse = P0; }
253	| case cases
254		{ $$.parse = pnode( $1.parse, $2.parse ); }
255	;
256
257case	: CASE_t ARG _COLON_t block
258		{ $$.parse = psnode( $2.string, $4.parse ); }
259	;
260
261/*
262 * params - optional parameter names to rule definition
263 * right-recursive rule so that params can be added in order.
264 */
265
266params	: /* empty */
267		{ $$.parse = P0; }
268	| ARG _COLON_t params
269		{ $$.parse = psnode( $1.string, $3.parse ); }
270	| ARG
271		{ $$.parse = psnode( $1.string, P0 ); }
272	;
273
274/*
275 * lol - list of lists
276 * right-recursive rule so that lists can be added in order.
277 */
278
279lol	: list
280		{ $$.parse = pnode( P0, $1.parse ); }
281	| list _COLON_t lol
282		{ $$.parse = pnode( $3.parse, $1.parse ); }
283	;
284
285/*
286 * list - zero or more args in a LIST
287 * listp - list (in puncutation only mode)
288 * arg - one ARG or function call
289 */
290
291list	: listp
292		{ $$.parse = $1.parse; yymode( SCAN_NORMAL ); }
293	;
294
295listp	: /* empty */
296		{ $$.parse = pnull(); yymode( SCAN_PUNCT ); }
297	| listp arg
298		{ $$.parse = pappend( $1.parse, $2.parse ); }
299	;
300
301arg	: ARG
302		{ $$.parse = plist( $1.string ); }
303	| _LBRACKET_t { yymode( SCAN_NORMAL ); } func _RBRACKET_t
304		{ $$.parse = $3.parse; }
305	;
306
307/*
308 * func - a function call (inside [])
309 * This needs to be split cleanly out of 'rule'
310 */
311
312func	: arg lol
313		{ $$.parse = prule( $1.parse, $2.parse ); }
314	| ON_t arg arg lol
315		{ $$.parse = pon( $2.parse, prule( $3.parse, $4.parse ) ); }
316	| ON_t arg RETURN_t list
317		{ $$.parse = pon( $2.parse, $4.parse ); }
318	;
319
320/*
321 * eflags - zero or more modifiers to 'executes'
322 * eflag - a single modifier to 'executes'
323 */
324
325eflags	: /* empty */
326		{ $$.number = 0; }
327	| eflags eflag
328		{ $$.number = $1.number | $2.number; }
329	;
330
331eflag	: UPDATED_t
332		{ $$.number = RULE_UPDATED; }
333	| TOGETHER_t
334		{ $$.number = RULE_TOGETHER; }
335	| IGNORE_t
336		{ $$.number = RULE_IGNORE; }
337	| QUIETLY_t
338		{ $$.number = RULE_QUIETLY; }
339	| PIECEMEAL_t
340		{ $$.number = RULE_PIECEMEAL; }
341	| EXISTING_t
342		{ $$.number = RULE_EXISTING; }
343	| MAXLINE_t ARG
344		{ $$.number = atoi( $2.string ) * RULE_MAXLINE; }
345	;
346
347
348/*
349 * bindlist - list of variable to bind for an action
350 */
351
352bindlist : /* empty */
353		{ $$.parse = pnull(); }
354	| BIND_t list
355		{ $$.parse = $2.parse; }
356	;
357
358
359