?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
tagged release 0.6.4
[parrot.git] / compilers / imcc / imcc.y
blob064bfbe956d170d74cfbc11d943eb5032b5ce9ea
1 %{
2 /*
3 * imcc.y
4 *
5 * Intermediate Code Compiler for Parrot.
6 *
7 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
8 * Copyright (C) 2002-2008, The Perl Foundation.
9 *
10 * Grammar of the PIR language parser.
11 *
12 * $Id$
13 *
14 */
15
16 #include <string.h>
17 #include <stdio.h>
18 #include <stdlib.h>
19
20 #define _PARSER
21 #define PARSER_MAIN
22 #include "imc.h"
23 #include "parrot/dynext.h"
24 #include "pbc.h"
25 #include "parser.h"
26 #include "optimizer.h"
27
28 #ifndef YYENABLE_NLS
29 # define YYENABLE_NLS 0
30 #endif
31
32 #ifndef YYLTYPE_IS_TRIVIAL
33 # define YYLTYPE_IS_TRIVIAL 0
34 #endif
35
36 /* HEADERIZER HFILE: compilers/imcc/imc.h */
37
38 /* HEADERIZER BEGIN: static */
39 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
40
41 static void add_pcc_named_arg(PARROT_INTERP,
42 ARGMOD(SymReg *cur_call),
43 ARGIN(const char *name),
44 ARGIN(SymReg *value))
45 __attribute__nonnull__(1)
46 __attribute__nonnull__(2)
47 __attribute__nonnull__(3)
48 __attribute__nonnull__(4)
49 FUNC_MODIFIES(*cur_call);
50
51 static void add_pcc_named_param(PARROT_INTERP,
52 ARGMOD(SymReg *cur_call),
53 ARGIN(const char *name),
54 ARGIN(SymReg *value))
55 __attribute__nonnull__(1)
56 __attribute__nonnull__(2)
57 __attribute__nonnull__(3)
58 __attribute__nonnull__(4)
59 FUNC_MODIFIES(*cur_call);
60
61 static void add_pcc_named_result(PARROT_INTERP,
62 ARGMOD(SymReg *cur_call),
63 ARGIN(const char *name),
64 ARGIN(SymReg *value))
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2)
67 __attribute__nonnull__(3)
68 __attribute__nonnull__(4)
69 FUNC_MODIFIES(*cur_call);
70
71 static void add_pcc_named_return(PARROT_INTERP,
72 ARGMOD(SymReg *cur_call),
73 ARGIN(const char *name),
74 ARGIN(SymReg *value))
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2)
77 __attribute__nonnull__(3)
78 __attribute__nonnull__(4)
79 FUNC_MODIFIES(*cur_call);
80
81 static void adv_named_set(PARROT_INTERP, ARGIN(char *name))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2);
84
85 static void begin_return_or_yield(PARROT_INTERP, int yield)
86 __attribute__nonnull__(1);
87
88 static void clear_state(PARROT_INTERP)
89 __attribute__nonnull__(1);
90
91 static void do_loadlib(PARROT_INTERP, ARGIN(const char *lib))
92 __attribute__nonnull__(1)
93 __attribute__nonnull__(2);
94
95 PARROT_WARN_UNUSED_RESULT
96 PARROT_CAN_RETURN_NULL
97 static Instruction* func_ins(PARROT_INTERP,
98 ARGMOD(IMC_Unit *unit),
99 ARGIN(SymReg *lhs),
100 ARGIN(const char *op),
101 ARGMOD(SymReg **r),
102 int n,
103 int keyv,
104 int emit)
105 __attribute__nonnull__(1)
106 __attribute__nonnull__(2)
107 __attribute__nonnull__(3)
108 __attribute__nonnull__(4)
109 __attribute__nonnull__(5)
110 FUNC_MODIFIES(*unit)
111 FUNC_MODIFIES(*r);
112
113 PARROT_CAN_RETURN_NULL
114 static Instruction * iINDEXFETCH(PARROT_INTERP,
115 ARGMOD(IMC_Unit *unit),
116 ARGIN(SymReg *r0),
117 ARGIN(SymReg *r1),
118 ARGIN(SymReg *r2))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2)
121 __attribute__nonnull__(3)
122 __attribute__nonnull__(4)
123 __attribute__nonnull__(5)
124 FUNC_MODIFIES(*unit);
125
126 PARROT_CAN_RETURN_NULL
127 static Instruction * iINDEXSET(PARROT_INTERP,
128 ARGMOD(IMC_Unit *unit),
129 ARGIN(SymReg *r0),
130 ARGIN(SymReg *r1),
131 ARGIN(SymReg *r2))
132 __attribute__nonnull__(1)
133 __attribute__nonnull__(2)
134 __attribute__nonnull__(3)
135 __attribute__nonnull__(4)
136 __attribute__nonnull__(5)
137 FUNC_MODIFIES(*unit);
138
139 PARROT_CANNOT_RETURN_NULL
140 static Instruction * iLABEL(PARROT_INTERP,
141 ARGMOD_NULLOK(IMC_Unit *unit),
142 ARGMOD(SymReg *r0))
143 __attribute__nonnull__(1)
144 __attribute__nonnull__(3)
145 FUNC_MODIFIES(*r0);
146
147 PARROT_WARN_UNUSED_RESULT
148 PARROT_CAN_RETURN_NULL
149 static const char * inv_op(ARGIN(const char *op))
150 __attribute__nonnull__(1);
151
152 PARROT_CANNOT_RETURN_NULL
153 static Instruction * iSUBROUTINE(PARROT_INTERP,
154 ARGMOD_NULLOK(IMC_Unit *unit),
155 ARGMOD(SymReg *r))
156 __attribute__nonnull__(1)
157 __attribute__nonnull__(3)
158 FUNC_MODIFIES(*r);
159
160 PARROT_IGNORABLE_RESULT
161 PARROT_CAN_RETURN_NULL
162 static Instruction * MK_I(PARROT_INTERP,
163 ARGMOD(IMC_Unit *unit),
164 ARGIN(const char *fmt),
165 int n,
166 ...)
167 __attribute__nonnull__(1)
168 __attribute__nonnull__(2)
169 __attribute__nonnull__(3)
170 FUNC_MODIFIES(*unit);
171
172 PARROT_WARN_UNUSED_RESULT
173 PARROT_CAN_RETURN_NULL
174 static Instruction* mk_pmc_const(PARROT_INTERP,
175 ARGMOD(IMC_Unit *unit),
176 ARGIN(const char *type),
177 ARGMOD(SymReg *left),
178 ARGIN(const char *constant))
179 __attribute__nonnull__(1)
180 __attribute__nonnull__(2)
181 __attribute__nonnull__(3)
182 __attribute__nonnull__(4)
183 __attribute__nonnull__(5)
184 FUNC_MODIFIES(*unit)
185 FUNC_MODIFIES(*left);
186
187 PARROT_CANNOT_RETURN_NULL
188 static SymReg * mk_sub_address_fromc(PARROT_INTERP, ARGIN(const char *name))
189 __attribute__nonnull__(1)
190 __attribute__nonnull__(2);
191
192 PARROT_CANNOT_RETURN_NULL
193 static SymReg * mk_sub_address_u(PARROT_INTERP, ARGIN(const char *name))
194 __attribute__nonnull__(1)
195 __attribute__nonnull__(2);
196
197 static void set_lexical(PARROT_INTERP,
198 ARGMOD(SymReg *r),
199 ARGIN(const char *name))
200 __attribute__nonnull__(1)
201 __attribute__nonnull__(2)
202 __attribute__nonnull__(3)
203 FUNC_MODIFIES(*r);
204
205 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
206 /* HEADERIZER END: static */
207
208
209 #define YYDEBUG 1
210 #define YYERROR_VERBOSE 1
211
212 /*
213 * We use a pure parser with the interpreter as a parameter. However this still
214 * doesn't make the parser reentrant, as there are too many globals around.
215 */
216
217 /*
218 * Choosing instructions for Parrot is pretty easy since many are
219 * polymorphic.
220 */
221
222
223 /*
224 * MK_I: build and emitb instruction by INS
225 *
226 * fmt may contain:
227 * op %s, %s # comment
228 * or just
229 * op
230 *
231 *
232 * NOTE: Most usage of this function is with
233 * IMCC_INFO(interp)->cur_unit, but there are some
234 * exceptions. Thus, we can't easily factorize that piece of
235 * code.
236 */
237
238 PARROT_IGNORABLE_RESULT
239 PARROT_CAN_RETURN_NULL
240 static Instruction *
241 MK_I(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...)
242 {
243 char opname[64];
244 char *p;
245 const char *q;
246 va_list ap;
247 SymReg *r[IMCC_MAX_FIX_REGS];
248 int i;
249
250 for (p = opname, q = fmt; *q && *q != ' ';)
251 *p++ = *q++;
252 *p = 0;
253 if (!*q)
254 fmt = NULL;
255 else
256 fmt = ++q;
257 #ifdef OPDEBUG
258 fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"", n);
259 #endif
260 va_start(ap, n);
261 i = 0;
262 for (i = 0; i < n; ++i) {
263 r[i] = va_arg(ap, SymReg *);
264 }
265 va_end(ap);
266 return INS(interp, unit, opname, fmt, r, n,
267 IMCC_INFO(interp)->keyvec, 1);
268 }
269
270 PARROT_WARN_UNUSED_RESULT
271 PARROT_CAN_RETURN_NULL
272 static Instruction*
273 mk_pmc_const(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(const char *type),
274 ARGMOD(SymReg *left), ARGIN(const char *constant))
275 {
276 const int type_enum = atoi(type);
277 const int ascii = (*constant == '\'' || *constant == '"');
278 SymReg *rhs;
279 SymReg *r[2];
280 char *name;
281
282 if (left->type == VTADDRESS) { /* IDENTIFIER */
283 if (IMCC_INFO(interp)->state->pasm_file) {
284 IMCC_fataly(interp, E_SyntaxError,
285 "Ident as PMC constant",
286 " %s\n", left->name);
287 }
288 left->type = VTIDENTIFIER;
289 left->set = 'P';
290 }
291 r[0] = left;
292 if (ascii) {
293 /* strip delimiters */
294 name = str_dup(constant + 1);
295 name[strlen(name) - 1] = '\0';
296 }
297 else {
298 name = str_dup(constant);
299 }
300
301 switch (type_enum) {
302 case enum_class_Sub:
303 case enum_class_Coroutine:
304 rhs = mk_const(interp, name, 'p');
305
306 if (!ascii)
307 rhs->type |= VT_ENCODED;
308
309 rhs->usage = U_FIXUP;
310 break;
311 default:
312 rhs = mk_const(interp, name, 'P');
313 break;
314 }
315
316 r[1] = rhs;
317 rhs->pmc_type = type_enum;
318
319 mem_sys_free(name);
320
321 return INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
322 }
323
324 PARROT_WARN_UNUSED_RESULT
325 PARROT_CAN_RETURN_NULL
326 static Instruction*
327 func_ins(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs), ARGIN(const char *op),
328 ARGMOD(SymReg **r), int n, int keyv, int emit)
329 {
330 int i;
331 /* shift regs up by 1 */
332 for (i = n - 1; i >= 0; --i)
333 r[i+1] = r[i];
334 r[0] = lhs;
335 /* shift keyvec */
336 keyv <<= 1;
337 return INS(interp, unit, op, "", r, n+1, keyv, emit);
338 }
339 /*
340 * special instructions
341 *
342 * labels and such
343 */
344
345 static void
346 clear_state(PARROT_INTERP)
347 {
348 IMCC_INFO(interp) -> nargs = 0;
349 IMCC_INFO(interp) -> keyvec = 0;
350 }
351
352 PARROT_CANNOT_RETURN_NULL
353 Instruction *
354 INS_LABEL(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0), int emit)
355 {
356
357 Instruction * const ins = _mk_instruction("", "%s:", 1, &r0, 0);
358 ins->type = ITLABEL;
359 r0->first_ins = ins;
360
361 if (emit)
362 emitb(interp, unit, ins);
363
364 return ins;
365 }
366
367 PARROT_CANNOT_RETURN_NULL
368 static Instruction *
369 iLABEL(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0))
370 {
371 Instruction * const i = INS_LABEL(interp, unit, r0, 1);
372 i->line = IMCC_INFO(interp)->line;
373
374 clear_state(interp);
375 return i;
376 }
377
378 PARROT_CANNOT_RETURN_NULL
379 static Instruction *
380 iSUBROUTINE(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r))
381 {
382 Instruction * const i = iLABEL(interp, unit, r);
383
384 r->type = (r->type & VT_ENCODED) ? VT_PCC_SUB|VT_ENCODED : VT_PCC_SUB;
385 r->pcc_sub = mem_allocate_zeroed_typed(pcc_sub_t);
386
387 IMCC_INFO(interp)->cur_call = r;
388 i->line = IMCC_INFO(interp)->line;
389
390 add_namespace(interp, unit);
391 return i;
392 }
393
394 /*
395 * substr or X = P[key]
396 */
397 PARROT_CAN_RETURN_NULL
398 static Instruction *
399 iINDEXFETCH(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1),
400 ARGIN(SymReg *r2))
401 {
402 if (r0->set == 'S' && r1->set == 'S' && r2->set == 'I') {
403 SymReg * const r3 = mk_const(interp, "1", 'I');
404 return MK_I(interp, unit, "substr %s, %s, %s, 1", 4, r0, r1, r2, r3);
405 }
406
407 IMCC_INFO(interp) -> keyvec |= KEY_BIT(2);
408 return MK_I(interp, unit, "set %s, %s[%s]", 3, r0, r1, r2);
409 }
410
411 /*
412 * substr or P[key] = X
413 */
414
415 PARROT_CAN_RETURN_NULL
416 static Instruction *
417 iINDEXSET(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1),
418 ARGIN(SymReg *r2))
419 {
420 if (r0->set == 'S' && r1->set == 'I' && r2->set == 'S') {
421 SymReg * const r3 = mk_const(interp, "1", 'I');
422 MK_I(interp, unit, "substr %s, %s, %s, %s", 4, r0, r1, r3, r2);
423 }
424 else if (r0->set == 'P') {
425 IMCC_INFO(interp)->keyvec |= KEY_BIT(1);
426 MK_I(interp, unit, "set %s[%s], %s", 3, r0, r1, r2);
427 }
428 else {
429 IMCC_fataly(interp, E_SyntaxError,
430 "unsupported indexed set op\n");
431 }
432 return NULL;
433 }
434
435 PARROT_WARN_UNUSED_RESULT
436 PARROT_CAN_RETURN_NULL
437 static const char *
438 inv_op(ARGIN(const char *op))
439 {
440 int n;
441 return get_neg_op(op, &n);
442 }
443
444 PARROT_CANNOT_RETURN_NULL
445 Instruction *
446 IMCC_create_itcall_label(PARROT_INTERP)
447 {
448 char name[128];
449 SymReg *r;
450 Instruction *i;
451
452 snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR,
453 IMCC_INFO(interp)->cnr++);
454
455 r = mk_pcc_sub(interp, name, 0);
456 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, r);
457 i->type = ITCALL | ITPCCSUB;
458
459 IMCC_INFO(interp)->cur_call = r;
460
461 return i;
462 }
463
464 PARROT_CANNOT_RETURN_NULL
465 static SymReg *
466 mk_sub_address_fromc(PARROT_INTERP, ARGIN(const char *name))
467 {
468 /* name is a quoted sub name */
469 SymReg *r;
470 char *name_copy = str_dup(name + 1);
471 name_copy[strlen(name_copy) - 1] = '\0';
472
473 r = mk_sub_address(interp, name_copy);
474 mem_sys_free(name_copy);
475
476 return r;
477 }
478
479 PARROT_CANNOT_RETURN_NULL
480 static SymReg *
481 mk_sub_address_u(PARROT_INTERP, ARGIN(const char *name))
482 {
483 SymReg * const r = mk_sub_address(interp, name);
484 r->type |= VT_ENCODED;
485
486 return r;
487 }
488
489 void
490 IMCC_itcall_sub(PARROT_INTERP, ARGIN(SymReg *sub))
491 {
492 IMCC_INFO(interp)->cur_call->pcc_sub->sub = sub;
493 if (IMCC_INFO(interp)->cur_obj) {
494 if (IMCC_INFO(interp)->cur_obj->set != 'P')
495 IMCC_fataly(interp, E_SyntaxError, "object isn't a PMC");
496 IMCC_INFO(interp)->cur_call->pcc_sub->object = IMCC_INFO(interp)->cur_obj;
497 IMCC_INFO(interp)->cur_obj = NULL;
498 }
499 if (IMCC_INFO(interp)->cur_call->pcc_sub->sub->pmc_type == enum_class_NCI)
500 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isNCI;
501 if (IMCC_INFO(interp)->cur_unit->type == IMC_PCCSUB)
502 IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub |= 1;
503 }
504
505 static void
506 begin_return_or_yield(PARROT_INTERP, int yield)
507 {
508 Instruction *i;
509 Instruction * const ins = IMCC_INFO(interp)->cur_unit->instructions;
510 char name[128];
511
512 if (!ins || !ins->symregs[0] || !(ins->symregs[0]->type & VT_PCC_SUB))
513 IMCC_fataly(interp, E_SyntaxError,
514 "yield or return directive outside pcc subroutine\n");
515 if (yield)
516 ins->symregs[0]->pcc_sub->calls_a_sub = 1 | ITPCCYIELD;
517 snprintf(name, sizeof (name), yield ? "%cpcc_sub_yield_%d" : "%cpcc_sub_ret_%d",
518 IMCC_INTERNAL_CHAR, IMCC_INFO(interp)->cnr++);
519 interp->imc_info->sr_return = mk_pcc_sub(interp, name, 0);
520 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, interp->imc_info->sr_return);
521 i->type = yield ? ITPCCSUB | ITLABEL | ITPCCYIELD : ITPCCSUB | ITLABEL ;
522 interp->imc_info->asm_state = yield ? AsmInYield : AsmInReturn;
523 }
524
525 static void
526 set_lexical(PARROT_INTERP, ARGMOD(SymReg *r), ARGIN(const char *name))
527 {
528 SymReg * const n = mk_const(interp, name, 'S');
529
530 r->usage |= U_LEXICAL;
531
532 if (n == r->reg)
533 IMCC_fataly(interp, E_SyntaxError,
534 "register %s already declared as lexical %s", r->name, n->name);
535
536 /* chain all names in r->reg */
537 n->reg = r->reg;
538 r->reg = n;
539 r->use_count++;
540 }
541
542 static void
543 add_pcc_named_arg(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
544 ARGIN(SymReg *value))
545 {
546 SymReg * const r = mk_const(interp, name, 'S');
547
548 r->type |= VT_NAMED;
549
550 add_pcc_arg(cur_call, r);
551 add_pcc_arg(cur_call, value);
552 }
553
554 static void
555 add_pcc_named_result(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
556 ARGIN(SymReg *value))
557 {
558 SymReg * const r = mk_const(interp, name, 'S');
559 r->type |= VT_NAMED;
560
561 add_pcc_result(cur_call, r);
562 add_pcc_result(cur_call, value);
563 }
564
565 static void
566 add_pcc_named_param(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
567 ARGIN(SymReg *value))
568 {
569 SymReg * const r = mk_const(interp, name, 'S');
570 r->type |= VT_NAMED;
571
572 add_pcc_arg(cur_call, r);
573 add_pcc_arg(cur_call, value);
574 }
575
576 static void
577 add_pcc_named_return(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
578 ARGIN(SymReg *value))
579 {
580 SymReg * const r = mk_const(interp, name, 'S');
581 r->type |= VT_NAMED;
582
583 add_pcc_result(cur_call, r);
584 add_pcc_result(cur_call, value);
585 }
586
587 /* XXX Can name be consted? */
588 static void
589 adv_named_set(PARROT_INTERP, ARGIN(char *name))
590 {
591 if (IMCC_INFO(interp)->adv_named_id) {
592 IMCC_fataly(interp, E_SyntaxError,
593 "Named parameter with more than one name.\n");
594 }
595 IMCC_INFO(interp)->adv_named_id = name;
596 }
597
598 static void
599 do_loadlib(PARROT_INTERP, ARGIN(const char *lib))
600 {
601 STRING * const s = string_unescape_cstring(interp, lib + 1, '"', NULL);
602 PMC *ignored = Parrot_load_lib(interp, s, NULL);
603 UNUSED(ignored);
604 Parrot_register_HLL_lib(interp, s);
605 }
606
607 /* HEADERIZER STOP */
608
609 %}
610
611 %union {
612 IdList * idlist;
613 int t;
614 char * s;
615 SymReg * sr;
616 Instruction *i;
617 }
618
619 /* We need precedence for a few tokens to resolve a couple of conflicts */
620 %nonassoc LOW_PREC
621 %nonassoc '\n'
622 %nonassoc <t> PARAM
623
624 %token <t> PRAGMA N_OPERATORS HLL HLL_MAP
625 %token <t> GOTO ARG IF UNLESS PNULL
626 %token <t> ADV_FLAT ADV_SLURPY ADV_OPTIONAL ADV_OPT_FLAG ADV_NAMED ADV_ARROW
627 %token <t> NEW ADV_INVOCANT
628 %token <t> NAMESPACE ENDNAMESPACE DOT_METHOD
629 %token <t> SUB SYM LOCAL LEXICAL CONST
630 %token <t> INC DEC GLOBAL_CONST
631 %token <t> PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN
632 %token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN MOD_ASSIGN
633 %token <t> SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN
634 %token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV LOG_XOR
635 %token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
636 %token <t> GLOBAL GLOBALOP ADDR RESULT RETURN YIELDT GET_RESULTS
637 %token <t> POW SHIFT_RIGHT_U LOG_AND LOG_OR
638 %token <t> COMMA ESUB DOTDOT
639 %token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
640 %token <t> PCC_BEGIN_YIELD PCC_END_YIELD NCI_CALL METH_CALL INVOCANT
641 %token <t> MAIN LOAD INIT IMMEDIATE POSTCOMP METHOD ANON OUTER NEED_LEX
642 %token <t> MULTI VTABLE_METHOD LOADLIB SUB_INSTANCE_OF SUB_LEXID
643 %token <t> UNIQUE_REG
644 %token <s> LABEL
645 %token <t> EMIT EOM
646 %token <s> IREG NREG SREG PREG IDENTIFIER REG MACRO ENDM
647 %token <s> STRINGC INTC FLOATC USTRINGC
648 %token <s> PARROT_OP
649 %type <t> type pragma_1 hll_def return_or_yield comma_or_goto opt_unique_reg
650 %type <i> program
651 %type <i> class_namespace
652 %type <i> constdef sub emit pcc_ret pcc_yield
653 %type <i> compilation_units compilation_unit pmc_const pragma
654 %type <s> classname relop any_string assign_op bin_op un_op
655 %type <i> labels _labels label statement sub_call
656 %type <i> pcc_sub_call
657 %type <sr> sub_param sub_params pcc_arg pcc_result pcc_args pcc_results sub_param_type_def
658 %type <sr> pcc_returns pcc_return pcc_call arg arglist the_sub multi_type
659 %type <t> argtype_list argtype paramtype_list paramtype
660 %type <t> pcc_return_many
661 %type <t> proto sub_proto sub_proto_list multi multi_types outer
662 %type <t> vtable instanceof lexid
663 %type <i> instruction assignment conditional_statement labeled_inst opt_label op_assign
664 %type <i> if_statement unless_statement
665 %type <i> func_assign get_results
666 %type <i> opt_invocant
667 %type <sr> target targetlist reg const var string result
668 %type <sr> keylist keylist_force _keylist key maybe_ns
669 %type <sr> vars _vars var_or_i _var_or_i label_op sub_label_op sub_label_op_c
670 %type <i> pasmcode pasmline pasm_inst
671 %type <sr> pasm_args
672 %type <i> var_returns
673 %token <sr> VAR
674
675 %token <t> LINECOMMENT
676 %token <s> FILECOMMENT
677 %type <idlist> id_list id_list_id
678
679 %nonassoc CONCAT DOT
680
681
682 /* %locations */
683 %pure_parser
684
685 /* Note that we pass interp last, because Bison only passes
686 the last param to yyerror(). (Tested on bison <= 2.3)
687 */
688 %parse-param {void *yyscanner}
689 %lex-param {void *yyscanner}
690 %parse-param {Parrot_Interp interp}
691 %lex-param {Parrot_Interp interp}
692
693 %start program
694
695 /* In effort to make the grammar readable but not militaristic, please space indent
696 code blocks on 10 col boundaries and keep indentation same for all code blocks
697 in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col
698 */
699
700 %%
701
702 program:
703 compilation_units { if (yynerrs) YYABORT; $$ = 0; }
704 ;
705
706 compilation_units:
707 compilation_unit
708 | compilation_units compilation_unit
709 ;
710
711 compilation_unit:
712 class_namespace { $$ = $1; }
713 | constdef { $$ = $1; }
714 | sub
715 {
716 $$ = $1;
717 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
718 IMCC_INFO(interp)->cur_unit = 0;
719 }
720 | emit
721 {
722 $$ = $1;
723 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
724 IMCC_INFO(interp)->cur_unit = 0;
725 }
726 | MACRO '\n' { $$ = 0; }
727 | pragma { $$ = 0; }
728 | '\n' { $$ = 0; }
729 ;
730
731 pragma:
732 PRAGMA pragma_1 '\n' { $$ = 0; }
733 | hll_def '\n' { $$ = 0; }
734 | LOADLIB STRINGC '\n'
735 {
736 $$ = 0;
737 do_loadlib(interp, $2);
738 mem_sys_free($2);
739 }
740 ;
741
742 pragma_1:
743 N_OPERATORS INTC
744 {
745 if ($2)
746 IMCC_INFO(interp)->state->pragmas |= PR_N_OPERATORS;
747 else
748 IMCC_INFO(interp)->state->pragmas &= ~PR_N_OPERATORS;
749 }
750 ;
751
752 hll_def:
753 HLL STRINGC COMMA STRINGC
754 {
755 STRING * const hll_name = string_unescape_cstring(interp, $2 + 1, '"', NULL);
756 CONTEXT(interp)->current_HLL =
757 Parrot_register_HLL(interp, hll_name);
758
759 /* don't bother loading the library for an empty string */
760 if (strlen($4) > 2) {
761 STRING * const hll_lib =
762 string_unescape_cstring(interp, $4 + 1, '"', NULL);
763 PMC *ignored = Parrot_load_lib(interp, hll_lib, NULL);
764 UNUSED(ignored);
765 Parrot_register_HLL_lib(interp, hll_lib);
766 }
767
768 IMCC_INFO(interp)->cur_namespace = NULL;
769 $$ = 0;
770 }
771 | HLL_MAP STRINGC COMMA STRINGC
772 {
773 Parrot_Context *ctx = CONTEXT(interp);
774 STRING * const built_in_name =
775 string_unescape_cstring(interp, $2 + 1, '"', NULL);
776 STRING * const language_name =
777 string_unescape_cstring(interp, $4 + 1, '"', NULL);
778
779 int built_in_type = pmc_type(interp, built_in_name);
780 int language_type = pmc_type(interp, language_name);
781
782 Parrot_register_HLL_type(interp, ctx->current_HLL,
783 built_in_type, language_type);
784 $$ = 0;
785 }
786 ;
787
788 constdef:
789 CONST { is_def = 1; } type IDENTIFIER '=' const
790 {
791 mk_const_ident(interp, $4, $3, $6, 1);
792 mem_sys_free($4);
793 is_def = 0;
794 }
795 ;
796
797 pmc_const:
798 CONST { is_def=1; } INTC var_or_i '=' any_string
799 {
800 $$ = mk_pmc_const(interp, IMCC_INFO(interp)->cur_unit, $3, $4, $6);
801 is_def = 0;
802 }
803 ;
804 any_string:
805 STRINGC
806 | USTRINGC
807 ;
808
809 pasmcode:
810 pasmline
811 | pasmcode pasmline
812 ;
813
814 pasmline:
815 labels pasm_inst '\n' { $$ = 0; }
816 | MACRO '\n' { $$ = 0; }
817 | FILECOMMENT { $$ = 0; }
818 | LINECOMMENT { $$ = 0; }
819 | class_namespace { $$ = $1; }
820 | pmc_const
821 | pragma
822 ;
823
824 pasm_inst: { clear_state(interp); }
825 PARROT_OP pasm_args
826 {
827 $$ = INS(interp, IMCC_INFO(interp)->cur_unit,
828 $2, 0, IMCC_INFO(interp)->regs,
829 IMCC_INFO(interp)->nargs, IMCC_INFO(interp) -> keyvec, 1);
830 /* XXX: can't seem to mem_sys_free($1) here */
831 }
832 | PCC_SUB
833 {
834 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
835 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM);
836 }
837 sub_proto LABEL
838 {
839 $$ = iSUBROUTINE(interp,
840 IMCC_INFO(interp)->cur_unit,
841 mk_sub_label(interp, $4));
842 IMCC_INFO(interp)->cur_call->pcc_sub->pragma = $3;
843 }
844 | PNULL var
845 {
846 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $2);
847 }
848 | LEXICAL STRINGC COMMA REG
849 {
850 SymReg *r = mk_pasm_reg(interp, $4);
851 set_lexical(interp, r, $2);
852 $$ = 0;
853 mem_sys_free($2);
854 mem_sys_free($4);
855 }
856 | /* none */ { $$ = 0;}
857 ;
858
859 pasm_args:
860 vars
861 ;
862
863 emit: /* EMIT and EOM tokens are used when compiling a .pasm file. */
864 EMIT { IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM); }
865 opt_pasmcode
866 EOM
867 {
868 /* if (optimizer_level & OPT_PASM)
869 imc_compile_unit(interp, IMCC_INFO(interp)->cur_unit);
870 emit_flush(interp);
871 */
872 $$ = 0;
873 }
874 ;
875
876 opt_pasmcode:
877 /* empty */
878 | pasmcode
879 ;
880
881 class_namespace:
882 NAMESPACE maybe_ns '\n'
883 {
884 int re_open = 0;
885 $$ = 0;
886 if (IMCC_INFO(interp)->state->pasm_file && IMCC_INFO(interp)->cur_namespace) {
887 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
888 re_open = 1;
889 }
890 IMCC_INFO(interp)->cur_namespace = $2;
891 if (re_open)
892 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM);
893 }
894 ;
895
896 maybe_ns:
897 '[' keylist ']' { $$ = $2; }
898 | '[' ']' { $$ = NULL; }
899 | { $$ = NULL; }
900 ;
901
902 sub:
903 SUB
904 {
905 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PCCSUB);
906 }
907 sub_label_op_c
908 {
909 iSUBROUTINE(interp, IMCC_INFO(interp)->cur_unit, $3);
910 }
911 sub_proto '\n' { IMCC_INFO(interp)->cur_call->pcc_sub->pragma = $5; }
912 sub_params
913 sub_body ESUB { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
914 ;
915
916 sub_params:
917 /* empty */ { $$ = 0; } %prec LOW_PREC
918 | '\n' { $$ = 0; }
919 | sub_params sub_param '\n'
920 {
921 if (IMCC_INFO(interp)->adv_named_id) {
922 add_pcc_named_param(interp, IMCC_INFO(interp)->cur_call,
923 IMCC_INFO(interp)->adv_named_id, $2);
924 IMCC_INFO(interp)->adv_named_id = NULL;
925 }
926 else
927 add_pcc_arg(IMCC_INFO(interp)->cur_call, $2);
928 }
929 ;
930
931 sub_param:
932 PARAM { is_def=1; } sub_param_type_def { $$ = $3; is_def=0; }
933 ;
934
935 sub_param_type_def:
936 type IDENTIFIER paramtype_list
937 {
938 if ($3 & VT_UNIQUE_REG)
939 $$ = mk_ident_ur(interp, $2, $1);
940 else
941 $$ = mk_ident(interp, $2, $1);
942 $$->type |= $3;
943 mem_sys_free($2);
944 }
945
946 /* don't free $2 here; adv_named_set uses the pointer directly */
947 | type STRINGC ADV_ARROW IDENTIFIER paramtype_list
948 {
949 if ($5 & VT_UNIQUE_REG)
950 $$ = mk_ident_ur(interp, $4, $1);
951 else
952 $$ = mk_ident(interp, $4, $1);
953 $$->type |= $5;
954 adv_named_set(interp, $2);
955 mem_sys_free($4);
956 }
957 ;
958
959
960
961 multi:
962 MULTI '(' multi_types ')' { $$ = 0; }
963 ;
964
965 outer:
966 OUTER '(' STRINGC ')'
967 {
968 $$ = 0;
969 IMCC_INFO(interp)->cur_unit->outer = mk_sub_address_fromc(interp, $3);
970 mem_sys_free($3);
971 }
972 | OUTER '(' IDENTIFIER ')'
973 {
974 $$ = 0;
975 IMCC_INFO(interp)->cur_unit->outer = mk_const(interp, $3, 'S');
976 mem_sys_free($3);
977 }
978 ;
979
980 vtable:
981 VTABLE_METHOD
982 {
983 $$ = 0;
984 IMCC_INFO(interp)->cur_unit->vtable_name = NULL;
985 IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
986 }
987 | VTABLE_METHOD '(' STRINGC ')'
988 {
989 $$ = 0;
990 IMCC_INFO(interp)->cur_unit->vtable_name = $3;
991 IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
992 }
993 ;
994
995 instanceof:
996 SUB_INSTANCE_OF '(' STRINGC ')'
997 {
998 $$ = 0;
999 IMCC_INFO(interp)->cur_unit->instance_of = mk_const(interp, $3, 'S');
1000 mem_sys_free($3);
1001 }
1002 ;
1003
1004 lexid:
1005 SUB_LEXID '(' STRINGC ')'
1006 {
1007 $$ = 0;
1008 IMCC_INFO(interp)->cur_unit->lexid = $3;
1009 }
1010 ;
1011
1012 multi_types:
1013 /* empty */
1014 {
1015 add_pcc_multi(IMCC_INFO(interp)->cur_call, NULL);
1016 }
1017 | multi_types COMMA multi_type
1018 {
1019 $$ = 0;
1020 add_pcc_multi(IMCC_INFO(interp)->cur_call, $3);
1021 }
1022 | multi_type
1023 {
1024 $$ = 0;
1025 add_pcc_multi(IMCC_INFO(interp)->cur_call, $1);
1026 }
1027 ;
1028
1029 multi_type:
1030 INTV { $$ = mk_const(interp, "INTVAL", 'S'); }
1031 | FLOATV { $$ = mk_const(interp, "FLOATVAL", 'S'); }
1032 | PMCV { $$ = mk_const(interp, "PMC", 'S'); }
1033 | STRINGV { $$ = mk_const(interp, "STRING", 'S'); }
1034 | IDENTIFIER
1035 {
1036 SymReg *r;
1037 if (strcmp($1, "_") != 0)
1038 r = mk_const(interp, $1, 'S');
1039 else {
1040 r = mk_const(interp, "PMC", 'S');
1041 }
1042 mem_sys_free($1);
1043 $$ = r;
1044 }
1045 | STRINGC
1046 {
1047 SymReg *r;
1048 if (strcmp($1, "_") != 0)
1049 r = mk_const(interp, $1, 'S');
1050 else {
1051 r = mk_const(interp, "PMC", 'S');
1052 }
1053 mem_sys_free($1);
1054 $$ = r;
1055 }
1056 | '[' keylist ']' { $$ = $2; }
1057 ;
1058
1059 sub_body:
1060 /* empty */
1061 | statements
1062 ;
1063
1064 pcc_sub_call:
1065 PCC_BEGIN '\n'
1066 {
1067 char name[128];
1068 SymReg *r, *r1;
1069 Instruction *i;
1070
1071 snprintf(name, sizeof (name), "%cpcc_sub_call_%d",
1072 IMCC_INTERNAL_CHAR, IMCC_INFO(interp)->cnr++);
1073 $<sr>$ = r = mk_pcc_sub(interp, name, 0);
1074 /* this mid rule action has the semantic value of the
1075 * sub SymReg.
1076 * This is used below to append args & results
1077 */
1078 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, r);
1079 IMCC_INFO(interp)->cur_call = r;
1080 i->type = ITPCCSUB;
1081 /*
1082 * if we are inside a pcc_sub mark the sub as doing a
1083 * sub call; the sub is in r[0] of the first ins
1084 */
1085 r1 = IMCC_INFO(interp)->cur_unit->instructions->symregs[0];
1086 if (r1 && r1->pcc_sub)
1087 r1->pcc_sub->calls_a_sub |= 1;
1088 }
1089 pcc_args
1090 opt_invocant
1091 pcc_call
1092 opt_label
1093 pcc_results
1094 PCC_END { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
1095 ;
1096
1097 opt_label:
1098 /* empty */ { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 0; }
1099 | label '\n' { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 1; }
1100 ;
1101
1102 opt_invocant:
1103 /* empty */ { $$ = NULL; }
1104 | INVOCANT var '\n' { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->object = $2; }
1105 ;
1106
1107 sub_proto:
1108 /* empty */ { $$ = 0; }
1109 | sub_proto_list
1110 ;
1111
1112 sub_proto_list:
1113 proto { $$ = $1; }
1114 | sub_proto_list proto { $$ = $1 | $2; }
1115 ;
1116
1117 proto:
1118 LOAD { $$ = P_LOAD; }
1119 | INIT { $$ = P_INIT; }
1120 | MAIN { $$ = P_MAIN; }
1121 | IMMEDIATE { $$ = P_IMMEDIATE; }
1122 | POSTCOMP { $$ = P_POSTCOMP; }
1123 | ANON { $$ = P_ANON; }
1124 | METHOD { $$ = P_METHOD; }
1125 | NEED_LEX { $$ = P_NEED_LEX; }
1126 | multi
1127 | outer
1128 | vtable
1129 | instanceof
1130 | lexid
1131 ;
1132
1133 pcc_call:
1134 PCC_CALL var COMMA var '\n'
1135 {
1136 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1137 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1138 }
1139 | PCC_CALL var '\n'
1140 {
1141 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1142 }
1143 | NCI_CALL var '\n'
1144 {
1145 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1146 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isNCI;
1147 }
1148 | METH_CALL target '\n'
1149 {
1150 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1151 }
1152 | METH_CALL STRINGC '\n'
1153 {
1154 add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, $2, 'S'));
1155 }
1156 | METH_CALL target COMMA var '\n'
1157 {
1158 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1159 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1160 }
1161 | METH_CALL STRINGC COMMA var '\n'
1162 {
1163 add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, $2, 'S'));
1164 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1165 }
1166 ;
1167
1168
1169 pcc_args:
1170 /* empty */ { $$ = 0; }
1171 | pcc_args pcc_arg '\n' { add_pcc_arg(IMCC_INFO(interp)->cur_call, $2); }
1172 ;
1173
1174 pcc_arg:
1175 ARG arg { $$ = $2; }
1176 ;
1177
1178
1179 pcc_results:
1180 /* empty */ { $$ = 0; }
1181 | pcc_results pcc_result '\n'
1182 {
1183 if ($2)
1184 add_pcc_result(IMCC_INFO(interp)->cur_call, $2);
1185 }
1186 ;
1187
1188 pcc_result:
1189 RESULT target paramtype_list { $$ = $2; $$->type |= $3; }
1190 | LOCAL { is_def=1; } type id_list_id
1191 {
1192 IdList *l = $4;
1193 SymReg *ignored;
1194 if (l->unique_reg)
1195 ignored = mk_ident_ur(interp, l->id, $3);
1196 else
1197 ignored = mk_ident(interp, l->id, $3);
1198 UNUSED(ignored);
1199 is_def=0;
1200 $$=0;
1201 }
1202 ;
1203
1204 paramtype_list:
1205 /* empty */ { $$ = 0; }
1206 | paramtype_list paramtype { $$ = $1 | $2; }
1207 ;
1208
1209 paramtype:
1210 ADV_SLURPY { $$ = VT_FLAT; }
1211 | ADV_OPTIONAL { $$ = VT_OPTIONAL; }
1212 | ADV_OPT_FLAG { $$ = VT_OPT_FLAG; }
1213 | ADV_NAMED { $$ = VT_NAMED; }
1214 | ADV_NAMED '(' STRINGC ')' { adv_named_set(interp, $3); $$ = 0; }
1215 | UNIQUE_REG { $$ = VT_UNIQUE_REG; }
1216 ;
1217
1218
1219 pcc_ret:
1220 PCC_BEGIN_RETURN '\n'
1221 {
1222 begin_return_or_yield(interp, 0);
1223 }
1224 pcc_returns PCC_END_RETURN
1225 {
1226 $$ = 0;
1227 IMCC_INFO(interp)->asm_state = AsmDefault;
1228 }
1229 | pcc_return_many
1230 {
1231 IMCC_INFO(interp)->asm_state = AsmDefault;
1232 $$ = 0;
1233 }
1234 ;
1235
1236 pcc_yield:
1237 PCC_BEGIN_YIELD '\n' { begin_return_or_yield(interp, 1); }
1238 pcc_returns
1239 PCC_END_YIELD { $$ = 0; IMCC_INFO(interp)->asm_state = AsmDefault; }
1240 ;
1241
1242 pcc_returns:
1243 /* empty */ { $$ = 0; }
1244 | pcc_returns '\n'
1245 {
1246 if ($1)
1247 add_pcc_result(IMCC_INFO(interp)->sr_return, $1);
1248 }
1249 | pcc_returns pcc_return '\n'
1250 {
1251 if ($2)
1252 add_pcc_result(IMCC_INFO(interp)->sr_return, $2);
1253 }
1254 ;
1255
1256 pcc_return:
1257 RETURN var argtype_list { $$ = $2; $$->type |= $3; }
1258 ;
1259
1260 pcc_return_many:
1261 return_or_yield '('
1262 {
1263 if (IMCC_INFO(interp)->asm_state == AsmDefault)
1264 begin_return_or_yield(interp, $1);
1265 }
1266 var_returns ')'
1267 {
1268 IMCC_INFO(interp)->asm_state = AsmDefault;
1269 $$ = 0;
1270 }
1271 ;
1272
1273 return_or_yield:
1274 RETURN { $$ = 0; }
1275 | YIELDT { $$ = 1; }
1276 ;
1277
1278 var_returns:
1279 /* empty */ { $$ = 0; }
1280 | arg
1281 {
1282 if (IMCC_INFO(interp)->adv_named_id) {
1283 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
1284 IMCC_INFO(interp)->adv_named_id, $1);
1285 IMCC_INFO(interp)->adv_named_id = NULL;
1286 }
1287 else
1288 add_pcc_result(IMCC_INFO(interp)->sr_return, $1);
1289 }
1290 | STRINGC ADV_ARROW var
1291 {
1292 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, $1, $3);
1293 }
1294 | var_returns COMMA arg
1295 {
1296 if (IMCC_INFO(interp)->adv_named_id) {
1297 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
1298 IMCC_INFO(interp)->adv_named_id, $3);
1299 IMCC_INFO(interp)->adv_named_id = NULL;
1300 }
1301 else
1302 add_pcc_result(IMCC_INFO(interp)->sr_return, $3);
1303 }
1304 | var_returns COMMA STRINGC ADV_ARROW var
1305 {
1306 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, $3, $5);
1307 }
1308 ;
1309
1310
1311 statements:
1312 statement
1313 | statements statement
1314 ;
1315
1316 /* This is ugly. Because 'instruction' can start with PARAM and in the
1317 * 'pcc_sub' rule, 'pcc_params' is followed by 'statement', we get a
1318 * shift/reduce conflict on PARAM between reducing to the dummy
1319 * { clear_state(); } rule and shifting the PARAM to be used as part
1320 * of the 'pcc_params' (which is what we want). However, yacc syntax
1321 * doesn't propagate precedence to the dummy rules, so we have to
1322 * split out the action just so that we can assign it a precedence. */
1323
1324 helper_clear_state:
1325 { clear_state(interp); } %prec LOW_PREC
1326 ;
1327
1328 statement:
1329 helper_clear_state
1330 instruction { $$ = $2; }
1331 | MACRO '\n' { $$ = 0; }
1332 | FILECOMMENT { $$ = 0; }
1333 | LINECOMMENT { $$ = 0; }
1334 ;
1335
1336 labels:
1337 /* none */ { $$ = NULL; }
1338 | _labels
1339 ;
1340
1341 _labels:
1342 _labels label
1343 | label
1344 ;
1345
1346 label:
1347 LABEL
1348 {
1349 $$ = iLABEL(interp, IMCC_INFO(interp)->cur_unit, mk_local_label(interp, $1));
1350 }
1351 ;
1352
1353
1354
1355 instruction:
1356 labels labeled_inst '\n' { $$ = $2; }
1357 | error '\n'
1358 {
1359 if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) {
1360 IMCC_warning(interp, "Too many errors. Correct some first.\n");
1361 YYABORT;
1362 }
1363 yyerrok;
1364 }
1365 ;
1366
1367 id_list :
1368 id_list_id
1369 {
1370 IdList* l = $1;
1371 l->next = NULL;
1372 $$ = l;
1373 }
1374
1375 | id_list COMMA id_list_id
1376 {
1377 IdList* l = $3;
1378 l->next = $1;
1379 $$ = l;
1380 }
1381 ;
1382
1383 id_list_id :
1384 IDENTIFIER opt_unique_reg
1385 {
1386 IdList* const l = mem_allocate_n_zeroed_typed(1, IdList);
1387 l->id = $1;
1388 l->unique_reg = $2;
1389 $$ = l;
1390 }
1391 ;
1392
1393 opt_unique_reg:
1394 /* empty */ { $$ = 0; }
1395 | UNIQUE_REG { $$ = 1; }
1396 ;
1397
1398
1399 labeled_inst:
1400 assignment
1401 | conditional_statement
1402 | NAMESPACE IDENTIFIER { push_namespace(interp, $2); mem_sys_free($2); }
1403 | ENDNAMESPACE IDENTIFIER { pop_namespace(interp, $2); mem_sys_free($2); }
1404 | LOCAL { is_def=1; } type id_list
1405 {
1406 IdList *l = $4;
1407 while (l) {
1408 IdList *l1;
1409 if (l->unique_reg)
1410 mk_ident_ur(interp, l->id, $3);
1411 else
1412 mk_ident(interp, l->id, $3);
1413 l1 = l;
1414 l = l->next;
1415 mem_sys_free(l1->id);
1416 mem_sys_free(l1);
1417 }
1418 is_def=0; $$=0;
1419 }
1420 | LEXICAL STRINGC COMMA target
1421 {
1422 set_lexical(interp, $4, $2); $$ = 0;
1423 }
1424 | CONST { is_def=1; } type IDENTIFIER '=' const
1425 {
1426 mk_const_ident(interp, $4, $3, $6, 0);
1427 is_def=0;
1428 mem_sys_free($4);
1429 }
1430
1431 | pmc_const
1432 | GLOBAL_CONST { is_def=1; } type IDENTIFIER '=' const
1433 {
1434 mk_const_ident(interp, $4, $3, $6, 1);
1435 is_def=0;
1436 mem_sys_free($4);
1437 }
1438 | RETURN sub_call
1439 {
1440 $$ = NULL;
1441 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isTAIL_CALL;
1442 IMCC_INFO(interp)->cur_call = NULL;
1443 }
1444 | GOTO label_op { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "branch", 1, $2); }
1445 | PARROT_OP vars
1446 {
1447 $$ = INS(interp,
1448 IMCC_INFO(interp)->cur_unit,
1449 $1,
1450 0,
1451 IMCC_INFO(interp)->regs,
1452 IMCC_INFO(interp)->nargs,
1453 IMCC_INFO(interp)->keyvec,
1454 1);
1455 mem_sys_free($1);
1456 }
1457 | PNULL var { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $2); }
1458 | sub_call { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
1459 | pcc_sub_call { $$ = 0; }
1460 | pcc_ret
1461 | pcc_yield
1462 | /* none */ { $$ = 0;}
1463 ;
1464
1465 type:
1466 INTV { $$ = 'I'; }
1467 | FLOATV { $$ = 'N'; }
1468 | STRINGV { $$ = 'S'; }
1469 | PMCV { $$ = 'P'; }
1470 ;
1471
1472 classname:
1473 IDENTIFIER
1474 {
1475 /* there'd normally be a str_dup() here, but the lexer already
1476 * copied the string, so it's safe to use directly */
1477 if ((IMCC_INFO(interp)->cur_pmc_type = pmc_type(interp,
1478 string_from_cstring(interp, $1, 0))) <= 0) {
1479 IMCC_fataly(interp, E_SyntaxError, "Unknown PMC type '%s'\n", $1);
1480 }
1481 }
1482 ;
1483
1484 assignment:
1485 target '=' var
1486 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "set", 2, $1, $3); }
1487 | target '=' un_op var
1488 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $3, 2, $1, $4); }
1489 | target '=' var bin_op var
1490 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $4, 3, $1, $3, $5); }
1491 | target '=' var '[' keylist ']'
1492 { $$ = iINDEXFETCH(interp, IMCC_INFO(interp)->cur_unit, $1, $3, $5); }
1493 | target '[' keylist ']' '=' var
1494 { $$ = iINDEXSET(interp, IMCC_INFO(interp)->cur_unit, $1, $3, $6); }
1495 | target '=' NEW classname COMMA var
1496 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, $6, 1); }
1497 | target '=' NEW classname '[' keylist ']'
1498 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, $6, 1); }
1499 | target '=' NEW classname
1500 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, NULL, 1); }
1501 | target '=' NEW var
1502 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $1, $4); }
1503 | target '=' NEW '[' keylist ']'
1504 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $1, $5); }
1505 | target '=' NEW '[' keylist ']' COMMA var
1506 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $5, $8); }
1507 | target '=' NEW var COMMA var
1508 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $4, $6); }
1509 | target '=' NEW var '[' keylist ']'
1510 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $4, $6); }
1511 | target '=' ADDR IDENTIFIER
1512 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "set_addr",
1513 2, $1, mk_label_address(interp, $4)); mem_sys_free($4); }
1514 | target '=' GLOBALOP string
1515 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "find_global", 2, $1, $4);}
1516 | GLOBALOP string '=' var
1517 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "store_global", 2, $2, $4); }
1518 /* NEW is here because it is both PIR and PASM keywords so we
1519 * have to handle the token here (or badly hack the lexer). */
1520 | NEW target COMMA var
1521 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $2, $4); }
1522 | NEW target COMMA var COMMA var
1523 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $2, $4, $6); }
1524 | NEW target COMMA var '[' keylist ']'
1525 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $2, $4, $6); }
1526 /* Subroutine call the short way */
1527 | target '=' sub_call
1528 {
1529 add_pcc_result($3->symregs[0], $1);
1530 IMCC_INFO(interp)->cur_call = NULL;
1531 $$ = 0;
1532 }
1533 | '('
1534 {
1535 $<i>$ = IMCC_create_itcall_label(interp);
1536 }
1537 targetlist ')' '=' the_sub '(' arglist ')'
1538 {
1539 IMCC_itcall_sub(interp, $6);
1540 IMCC_INFO(interp)->cur_call = NULL;
1541 }
1542 | get_results
1543 | op_assign
1544 | func_assign
1545 | target '=' PNULL
1546 {
1547 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $1);
1548 }
1549 ;
1550
1551 /* C++ hates implicit casts from string constants to char *, so be explicit */
1552 un_op:
1553 '!' { $$ = (char *)"not"; }
1554 | '~' { $$ = (char *)"bnot"; }
1555 | '-' { $$ = (char *)"neg"; }
1556 ;
1557
1558 bin_op:
1559 '-' { $$ = (char *)"sub"; }
1560 | '+' { $$ = (char *)"add"; }
1561 | '*' { $$ = (char *)"mul"; }
1562 | '/' { $$ = (char *)"div"; }
1563 | '%' { $$ = (char *)"mod"; }
1564 | FDIV { $$ = (char *)"fdiv"; }
1565 | POW { $$ = (char *)"pow"; }
1566 | CONCAT { $$ = (char *)"concat"; }
1567 | RELOP_EQ { $$ = (char *)"iseq"; }
1568 | RELOP_NE { $$ = (char *)"isne"; }
1569 | RELOP_GT { $$ = (char *)"isgt"; }
1570 | RELOP_GTE { $$ = (char *)"isge"; }
1571 | RELOP_LT { $$ = (char *)"islt"; }
1572 | RELOP_LTE { $$ = (char *)"isle"; }
1573 | SHIFT_LEFT { $$ = (char *)"shl"; }
1574 | SHIFT_RIGHT { $$ = (char *)"shr"; }
1575 | SHIFT_RIGHT_U { $$ = (char *)"lsr"; }
1576 | LOG_AND { $$ = (char *)"and"; }
1577 | LOG_OR { $$ = (char *)"or"; }
1578 | LOG_XOR { $$ = (char *)"xor"; }
1579 | '&' { $$ = (char *)"band"; }
1580 | '|' { $$ = (char *)"bor"; }
1581 | '~' { $$ = (char *)"bxor"; }
1582 ;
1583
1584
1585 get_results:
1586 GET_RESULTS
1587 {
1588 $$ = IMCC_create_itcall_label(interp);
1589 $$->type &= ~ITCALL;
1590 $$->type |= ITRESULT;
1591 }
1592 '(' targetlist ')' { $$ = 0; }
1593 ;
1594
1595
1596
1597 op_assign:
1598 target assign_op var
1599 {
1600 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $2, 2, $1, $3);
1601 }
1602 ;
1603
1604 assign_op:
1605 PLUS_ASSIGN { $$ = (char *)"add"; }
1606 | MINUS_ASSIGN { $$ = (char *)"sub"; }
1607 | MUL_ASSIGN { $$ = (char *)"mul"; }
1608 | DIV_ASSIGN { $$ = (char *)"div"; }
1609 | MOD_ASSIGN { $$ = (char *)"mod"; }
1610 | FDIV_ASSIGN { $$ = (char *)"fdiv"; }
1611 | CONCAT_ASSIGN { $$ = (char *)"concat"; }
1612 | BAND_ASSIGN { $$ = (char *)"band"; }
1613 | BOR_ASSIGN { $$ = (char *)"bor"; }
1614 | BXOR_ASSIGN { $$ = (char *)"bxor"; }
1615 | SHR_ASSIGN { $$ = (char *)"shr"; }
1616 | SHL_ASSIGN { $$ = (char *)"shl"; }
1617 | SHR_U_ASSIGN { $$ = (char *)"lsr"; }
1618 ;
1619
1620
1621 func_assign:
1622 target '=' PARROT_OP pasm_args
1623 {
1624 $$ = func_ins(interp, IMCC_INFO(interp)->cur_unit, $1, $3,
1625 IMCC_INFO(interp) -> regs,
1626 IMCC_INFO(interp) -> nargs,
1627 IMCC_INFO(interp) -> keyvec, 1);
1628 mem_sys_free($3);
1629 }
1630 ;
1631
1632 the_sub:
1633 IDENTIFIER { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1634 | STRINGC { $$ = mk_sub_address_fromc(interp, $1); mem_sys_free($1); }
1635 | USTRINGC { $$ = mk_sub_address_u(interp, $1); mem_sys_free($1); }
1636 | target
1637 {
1638 $$ = $1;
1639 if ($1->set != 'P')
1640 IMCC_fataly(interp, E_SyntaxError, "Sub isn't a PMC");
1641 }
1642 | target DOT sub_label_op { IMCC_INFO(interp)->cur_obj = $1; $$ = $3; }
1643 | target DOT STRINGC
1644 {
1645 IMCC_INFO(interp)->cur_obj = $1; $$ = mk_const(interp, $3, 'S');
1646 mem_sys_free($3);
1647 }
1648 | target DOT target { IMCC_INFO(interp)->cur_obj = $1; $$ = $3; }
1649 ;
1650
1651
1652 sub_call:
1653 the_sub
1654 {
1655 $$ = IMCC_create_itcall_label(interp);
1656 IMCC_itcall_sub(interp, $1);
1657 }
1658 '(' arglist ')' { $$ = $<i>2; }
1659 ;
1660
1661 arglist:
1662 /* empty */ { $$ = 0; }
1663 | arglist COMMA arg
1664 {
1665 $$ = 0;
1666 if (IMCC_INFO(interp)->adv_named_id) {
1667 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $3);
1668 IMCC_INFO(interp)->adv_named_id = NULL;
1669 }
1670 else
1671 add_pcc_arg(IMCC_INFO(interp)->cur_call, $3);
1672 }
1673 | arg
1674 {
1675 $$ = 0;
1676 if (IMCC_INFO(interp)->adv_named_id) {
1677 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $1);
1678 IMCC_INFO(interp)->adv_named_id = NULL;
1679 }
1680 else
1681 add_pcc_arg(IMCC_INFO(interp)->cur_call, $1);
1682 }
1683 | arglist COMMA STRINGC ADV_ARROW var
1684 {
1685 $$ = 0;
1686 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, $3, $5);
1687 mem_sys_free($3);
1688 }
1689 | STRINGC ADV_ARROW var
1690 {
1691 $$ = 0;
1692 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, $1, $3);
1693 mem_sys_free($1);
1694 }
1695 ;
1696
1697 arg:
1698 var argtype_list { $$ = $1; $$->type |= $2; }
1699 ;
1700
1701 argtype_list:
1702 /* empty */ { $$ = 0; }
1703 | argtype_list argtype { $$ = $1 | $2; }
1704 ;
1705
1706 argtype:
1707 ADV_FLAT { $$ = VT_FLAT; }
1708 | ADV_NAMED { $$ = VT_NAMED; }
1709
1710 /* don't free $3 here; adv_named_set uses the pointer directly */
1711 | ADV_NAMED '(' STRINGC ')' { adv_named_set(interp, $3); $$ = 0; }
1712 ;
1713
1714 result:
1715 target paramtype_list { $$ = $1; $$->type |= $2; }
1716 ;
1717
1718 targetlist:
1719 targetlist COMMA result
1720 {
1721 $$ = 0;
1722 if (IMCC_INFO(interp)->adv_named_id) {
1723 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $3);
1724 IMCC_INFO(interp)->adv_named_id = NULL;
1725 }
1726 else
1727 add_pcc_result(IMCC_INFO(interp)->cur_call, $3);
1728 }
1729 | targetlist COMMA STRINGC ADV_ARROW target
1730 {
1731 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, $3, $5);
1732 mem_sys_free($3);
1733 }
1734 | result
1735 {
1736 $$ = 0;
1737 if (IMCC_INFO(interp)->adv_named_id) {
1738 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $1);
1739 IMCC_INFO(interp)->adv_named_id = NULL;
1740 }
1741 else
1742 add_pcc_result(IMCC_INFO(interp)->cur_call, $1);
1743 }
1744 | STRINGC ADV_ARROW target
1745 {
1746 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, $1, $3);
1747 mem_sys_free($1);
1748 }
1749 | /* empty */ { $$ = 0; }
1750 ;
1751
1752 conditional_statement:
1753 if_statement { $$ = $1; }
1754 | unless_statement { $$ = $1; }
1755 ;
1756
1757 unless_statement:
1758 UNLESS var relop var GOTO label_op
1759 {
1760 $$ =MK_I(interp, IMCC_INFO(interp)->cur_unit, inv_op($3), 3, $2, $4, $6);
1761 }
1762 | UNLESS PNULL var GOTO label_op
1763 {
1764 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless_null", 2, $3, $5);
1765 }
1766 | UNLESS var comma_or_goto label_op
1767 {
1768 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless", 2, $2, $4);
1769 }
1770 ;
1771
1772 if_statement:
1773 IF var comma_or_goto label_op
1774 {
1775 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if", 2, $2, $4);
1776 }
1777 | IF var relop var GOTO label_op
1778 {
1779 $$ =MK_I(interp, IMCC_INFO(interp)->cur_unit, $3, 3, $2, $4, $6);
1780 }
1781 | IF PNULL var GOTO label_op
1782 {
1783 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if_null", 2, $3, $5);
1784 }
1785 ;
1786
1787 comma_or_goto:
1788 COMMA { $$ = 0; }
1789 | GOTO { $$ = 0; }
1790 ;
1791
1792 relop:
1793 RELOP_EQ { $$ = (char *)"eq"; }
1794 | RELOP_NE { $$ = (char *)"ne"; }
1795 | RELOP_GT { $$ = (char *)"gt"; }
1796 | RELOP_GTE { $$ = (char *)"ge"; }
1797 | RELOP_LT { $$ = (char *)"lt"; }
1798 | RELOP_LTE { $$ = (char *)"le"; }
1799 ;
1800
1801 target:
1802 VAR
1803 | reg
1804 ;
1805
1806 vars:
1807 /* empty */ { $$ = NULL; }
1808 | _vars { $$ = $1; }
1809 ;
1810
1811 _vars:
1812 _vars COMMA _var_or_i { $$ = IMCC_INFO(interp)->regs[0]; }
1813 | _var_or_i
1814 ;
1815
1816 _var_or_i:
1817 var_or_i { IMCC_INFO(interp)->regs[IMCC_INFO(interp)->nargs++] = $1; }
1818 | target '[' keylist ']'
1819 {
1820 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $1;
1821 IMCC_INFO(interp) -> keyvec |= KEY_BIT(IMCC_INFO(interp)->nargs);
1822 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $3;
1823 $$ = $1;
1824 }
1825 | '[' keylist_force ']'
1826 {
1827 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $2;
1828 $$ = $2;
1829 }
1830 ;
1831 sub_label_op_c:
1832 sub_label_op
1833 | STRINGC { $$ = mk_sub_address_fromc(interp, $1); mem_sys_free($1); }
1834 | USTRINGC { $$ = mk_sub_address_u(interp, $1); mem_sys_free($1); }
1835 ;
1836
1837 sub_label_op:
1838 IDENTIFIER { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1839 | PARROT_OP { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1840 ;
1841
1842 label_op:
1843 IDENTIFIER { $$ = mk_label_address(interp, $1); mem_sys_free($1); }
1844 | PARROT_OP { $$ = mk_label_address(interp, $1); mem_sys_free($1); }
1845 ;
1846
1847 var_or_i:
1848 label_op
1849 | var
1850 ;
1851
1852 var:
1853 target
1854 | const
1855 ;
1856
1857 keylist:
1858 {
1859 IMCC_INFO(interp)->nkeys = 0;
1860 IMCC_INFO(interp)->in_slice = 0;
1861 }
1862 _keylist
1863 {
1864 $$ = link_keys(interp,
1865 IMCC_INFO(interp)->nkeys,
1866 IMCC_INFO(interp)->keys, 0);
1867 }
1868 ;
1869
1870 keylist_force:
1871 {
1872 IMCC_INFO(interp)->nkeys = 0;
1873 IMCC_INFO(interp)->in_slice = 0;
1874 }
1875 _keylist
1876 {
1877 $$ = link_keys(interp,
1878 IMCC_INFO(interp)->nkeys,
1879 IMCC_INFO(interp)->keys, 1);
1880 }
1881 ;
1882
1883 _keylist:
1884 key { IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $1; }
1885 | _keylist ';' key
1886 {
1887 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $3;
1888 $$ = IMCC_INFO(interp)->keys[0];
1889 }
1890 | _keylist COMMA { IMCC_INFO(interp)->in_slice = 1; }
1891 key
1892 {
1893 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $4;
1894 $$ = IMCC_INFO(interp)->keys[0];
1895 }
1896 ;
1897
1898 key:
1899 var
1900 {
1901 if (IMCC_INFO(interp)->in_slice)
1902 $1->type |= VT_START_SLICE | VT_END_SLICE;
1903 $$ = $1;
1904 }
1905 | var DOTDOT var
1906 {
1907 $1->type |= VT_START_SLICE;
1908 $3->type |= VT_END_SLICE;
1909 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $1;
1910 $$ = $3;
1911 }
1912 | DOTDOT var { $2->type |= VT_START_ZERO | VT_END_SLICE; $$ = $2; }
1913 | var DOTDOT { $1->type |= VT_START_SLICE | VT_END_INF; $$ = $1; }
1914 ;
1915
1916 reg:
1917 IREG { $$ = mk_symreg(interp, $1, 'I'); }
1918 | NREG { $$ = mk_symreg(interp, $1, 'N'); }
1919 | SREG { $$ = mk_symreg(interp, $1, 'S'); }
1920 | PREG { $$ = mk_symreg(interp, $1, 'P'); }
1921 | REG { $$ = mk_pasm_reg(interp, $1); mem_sys_free($1); }
1922 ;
1923
1924 const:
1925 INTC { $$ = mk_const(interp, $1, 'I'); mem_sys_free($1); }
1926 | FLOATC { $$ = mk_const(interp, $1, 'N'); mem_sys_free($1); }
1927 | STRINGC { $$ = mk_const(interp, $1, 'S'); mem_sys_free($1); }
1928 | USTRINGC { $$ = mk_const(interp, $1, 'U'); mem_sys_free($1); }
1929 ;
1930
1931 string:
1932 SREG { $$ = mk_symreg(interp, $1, 'S'); mem_sys_free($1); }
1933 | STRINGC { $$ = mk_const(interp, $1, 'S'); mem_sys_free($1); }
1934 ;
1935
1936
1937 /* The End */
1938 %%
1939
1940 /* I need this prototype somewhere... */
1941 char *yyget_text(yyscan_t yyscanner);
1942
1943 /* I do not like this function, but, atm, it is the only way I can
1944 * make the code in yyerror work without segfault on some specific
1945 * cases.
1946 */
1947 /* int yyholds_char(yyscan_t yyscanner); */
1948
1949 int yyerror(void *yyscanner, PARROT_INTERP, const char *s)
1950 {
1951 /* If the error occurr in the end of the buffer (I mean, the last
1952 * token was already read), yyget_text will return a pointer
1953 * outside the bison buffer, and thus, not "accessible" by
1954 * us. This means it may segfault. */
1955 const char * const chr = yyget_text((yyscan_t)yyscanner);
1956
1957 /* IMCC_fataly(interp, E_SyntaxError, s); */
1958 /* --- This was called before, not sure if I should call some
1959 similar function that does not die like this one. */
1960
1961 /* Basically, if current token is a newline, it mean the error was
1962 * before the newline, and thus, line is the line *after* the
1963 * error. Instead of duplicating code for both cases (the 'newline' and
1964 * non-newline case, do the test twice; efficiency is not important when
1965 * we have an error anyway.
1966 */
1967 if (!at_eof(yyscanner)) {
1968 if (*chr == '\n') {
1969 IMCC_INFO(interp)->line--;
1970 }
1971
1972 IMCC_warning(interp, "error:imcc:%s", s);
1973 /* don't print the current token if it is a newline */
1974 if (*chr != '\n') {
1975 IMCC_warning(interp, " ('%s')", chr);
1976 }
1977 IMCC_print_inc(interp);
1978
1979 if (*chr == '\n') {
1980 IMCC_INFO(interp)->line++;
1981 }
1982
1983 }
1984 else { /* scanner is at end of file; just to be sure, do not print "current" token. */
1985 IMCC_warning(interp, "error:imcc:%s", s);
1986 IMCC_print_inc(interp);
1987 }
1988
1989 return 0;
1990 }
1991
1992 /*
1993 * Local variables:
1994 * c-file-style: "parrot"
1995 * End:
1996 * vim: expandtab shiftwidth=4:
1997 */
parrot vm git mirror