with debug
[prop.git] / prop-src / selector.cc
blobf23c1f6d18752244469049d1ffec98c5a4dde3bc
1 ///////////////////////////////////////////////////////////////////////////////
2 // This file is generated automatically using Prop (version 2.3.6),
3 // last updated on Nov 2, 1999.
4 // The original source file is "selector.pcc".
5 ///////////////////////////////////////////////////////////////////////////////
7 #define PROP_QUARK_USED
8 #include <propdefs.h>
9 ///////////////////////////////////////////////////////////////////////////////
10 // Quark literals
11 ///////////////////////////////////////////////////////////////////////////////
12 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q1("deref_");
13 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q2("derefp");
14 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q6("tag__");
15 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q5("untagp");
16 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q3("_");
17 static const Quark _s_e_l_e_c_t_o_rco_c_c_Q4("untag");
18 #line 1 "selector.pcc"
19 ///////////////////////////////////////////////////////////////////////////////
21 // This file implements the selection/projection code generation.
23 ///////////////////////////////////////////////////////////////////////////////
25 #include <string.h>
26 #include <limits.h>
27 #include <stdlib.h>
28 #include <AD/strings/quark.h>
29 #include "ir.h"
30 #include "ast.h"
31 #include "matchcom.h"
32 #include "type.h"
33 #include "options.h"
35 ///////////////////////////////////////////////////////////////////////////////
37 // Method to compute the proper selector into a component argument
38 // of a constructor
40 ///////////////////////////////////////////////////////////////////////////////
41 Exp select(Exp e, Cons c, Ty t) { return SELECTORexp(e,c,t); }
43 ///////////////////////////////////////////////////////////////////////////////
45 // Method to compute the proper selector into a component argument
46 // of a constructor
48 ///////////////////////////////////////////////////////////////////////////////
49 Exp MatchCompiler::make_select
50 ( Exp e, // the expression
51 Cons c, // constructor
52 Ty expected_ty, // expected type (if applicable)
53 Id component // component to extract
55 { Exp result = e;
56 Bool use_projection = component != 0;
58 #line 39 "selector.pcc"
59 #line 110 "selector.pcc"
61 if (c) {
62 if (c->alg_ty) {
63 switch (c->alg_ty->tag__) {
64 case a_Ty::tag_TYCONty: {
65 if (boxed(((Ty_TYCONty *)c->alg_ty)->_1)) {
66 switch (((Ty_TYCONty *)c->alg_ty)->_1->tag__) {
67 case a_TyCon::tag_DATATYPEtycon: {
68 if (
69 #line 43 "selector.pcc"
70 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->qualifiers & QUALview)
71 #line 43 "selector.pcc"
72 ) {
74 #line 44 "selector.pcc"
75 Ty comp_ty = c->ty;
76 if (component)
78 #line 46 "selector.pcc"
79 #line 52 "selector.pcc"
81 Ty _V1 = c->ty;
82 if (_V1) {
83 switch (_V1->tag__) {
84 case a_Ty::tag_TYCONty: {
85 if (boxed(((Ty_TYCONty *)_V1)->_1)) {
86 switch (((Ty_TYCONty *)_V1)->_1->tag__) {
87 case a_TyCon::tag_RECORDtycon: {
88 #line 50 "selector.pcc"
89 use_projection = false;
90 comp_ty = component_ty(c->ty,component);
91 #line 51 "selector.pcc"
92 } break;
93 default: {
94 L1:;
95 #line 52 "selector.pcc"
96 comp_ty = _V1;
97 #line 52 "selector.pcc"
98 } break;
100 } else {
101 switch ((int)((Ty_TYCONty *)_V1)->_1) {
102 case ((int)TUPLEtycon): {
103 #line 47 "selector.pcc"
104 use_projection = false;
105 comp_ty = component_ty(c->ty,atol(component+1));
106 #line 48 "selector.pcc"
107 } break;
108 default: { goto L1; } break;
111 } break;
112 default: { goto L1; } break;
114 } else { goto L1; }
116 #line 53 "selector.pcc"
117 #line 53 "selector.pcc"
120 Exp selector_exp = default_val(comp_ty);
121 if (selector_exp == NOexp)
122 { error ("%Lview accessor is undefined for constructor %s\n", c->name);
123 return NOexp;
125 result = subst(selector_exp,&e);
127 #line 61 "selector.pcc"
128 } else {
130 #line 68 "selector.pcc"
131 Bool simple;
134 #line 70 "selector.pcc"
135 #line 72 "selector.pcc"
137 Ty _V2 = c->ty;
138 if (_V2) {
139 switch (_V2->tag__) {
140 case a_Ty::tag_TYCONty: {
141 if (boxed(((Ty_TYCONty *)_V2)->_1)) {
142 switch (((Ty_TYCONty *)_V2)->_1->tag__) {
143 case a_TyCon::tag_RECORDtycon: {
144 L2:;
145 #line 71 "selector.pcc"
146 simple = false;
147 #line 71 "selector.pcc"
148 } break;
149 default: {
150 L3:;
151 #line 72 "selector.pcc"
152 simple = true;
153 #line 72 "selector.pcc"
154 } break;
156 } else {
157 switch ((int)((Ty_TYCONty *)_V2)->_1) {
158 case ((int)TUPLEtycon): { goto L2; } break;
159 default: { goto L3; } break;
162 } break;
163 default: { goto L3; } break;
165 } else { goto L3; }
167 #line 73 "selector.pcc"
168 #line 73 "selector.pcc"
170 if (is_array_constructor(c->name)) simple = false;
172 Id nm = mangle(c->name);
174 if (c->opt & OPTunboxed) {
175 result = APPexp(IDexp(
176 #line 79 "selector.pcc"
177 #line 79 "selector.pcc"
178 _s_e_l_e_c_t_o_rco_c_c_Q1
179 #line 79 "selector.pcc"
180 #line 79 "selector.pcc"
181 + c->name), e);
182 } else {
183 if ((((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->opt & OPTtaggedpointer) && c->tag != 0)
184 e = APPexp(IDexp(
185 #line 82 "selector.pcc"
186 #line 82 "selector.pcc"
187 _s_e_l_e_c_t_o_rco_c_c_Q2
188 #line 82 "selector.pcc"
189 #line 82 "selector.pcc"
190 ), e);
191 if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->opt & OPTsubclassless) { // No subclass hierarchy
192 if (simple) result = ARROWexp(e,nm);
193 else result = DEREFexp(e);
194 } else { // with subclass hierachy
195 // Dereference the pointer if the pointer needs to be stripped
196 // of the tag.
197 Exp downcast_exp = NOexp;
198 if (options.inline_casts && ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->tyvars ==
199 #line 90 "selector.pcc"
200 #line 90 "selector.pcc"
201 nil_1_
202 #line 90 "selector.pcc"
203 #line 90 "selector.pcc"
205 downcast_exp =
206 CASTexp(mkptrty(mkidty(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->id +
207 #line 92 "selector.pcc"
208 #line 92 "selector.pcc"
209 _s_e_l_e_c_t_o_rco_c_c_Q3
210 #line 92 "selector.pcc"
211 #line 92 "selector.pcc"
212 + nm,
213 #line 92 "selector.pcc"
214 #line 92 "selector.pcc"
215 nil_1_
216 #line 92 "selector.pcc"
217 #line 92 "selector.pcc"
218 )),e);
219 } else if (options.inline_casts && expected_ty != NOty) {
221 #line 94 "selector.pcc"
222 #line 99 "selector.pcc"
224 Ty _V3 = deref_all(expected_ty);
225 if (_V3) {
226 switch (_V3->tag__) {
227 case a_Ty::tag_TYCONty: {
228 #line 96 "selector.pcc"
229 downcast_exp =
230 CASTexp(mkptrty(mkidty(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->id +
231 #line 97 "selector.pcc"
232 #line 97 "selector.pcc"
233 _s_e_l_e_c_t_o_rco_c_c_Q3
234 #line 97 "selector.pcc"
235 #line 97 "selector.pcc"
236 + nm,((Ty_TYCONty *)_V3)->_2)),e);
238 #line 98 "selector.pcc"
239 } break;
240 default: {
241 L4:;
242 #line 99 "selector.pcc"
243 bug("%Lmake_select");
244 #line 99 "selector.pcc"
245 } break;
247 } else { goto L4; }
249 #line 100 "selector.pcc"
250 #line 100 "selector.pcc"
252 } else {
253 downcast_exp = APPexp(IDexp(
254 #line 102 "selector.pcc"
255 #line 102 "selector.pcc"
256 _s_e_l_e_c_t_o_rco_c_c_Q3
257 #line 102 "selector.pcc"
258 #line 102 "selector.pcc"
259 + nm),e);
261 if (simple) result = ARROWexp(downcast_exp,nm);
262 else result = DEREFexp(downcast_exp);
266 #line 108 "selector.pcc"
268 } break;
269 default: {
270 L5:; } break;
272 } else { goto L5; }
273 } break;
274 default: { goto L5; } break;
276 } else { goto L5; }
277 } else { goto L5; }
279 #line 110 "selector.pcc"
280 #line 110 "selector.pcc"
282 return use_projection ? DOTexp(result,component) : result;
285 ///////////////////////////////////////////////////////////////////////////////
287 // Method to compute the tag name of a constructor
289 ///////////////////////////////////////////////////////////////////////////////
290 Exp MatchCompiler::tag_name_of(Cons cons, Bool normalized)
293 #line 121 "selector.pcc"
294 #line 145 "selector.pcc"
296 if (cons) {
297 if (cons->alg_ty) {
298 switch (cons->alg_ty->tag__) {
299 case a_Ty::tag_TYCONty: {
300 if (cons->ty) {
301 L6:;
302 if (boxed(((Ty_TYCONty *)cons->alg_ty)->_1)) {
303 switch (((Ty_TYCONty *)cons->alg_ty)->_1->tag__) {
304 case a_TyCon::tag_DATATYPEtycon: {
305 L7:;
306 if (
307 #line 125 "selector.pcc"
308 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->qualifiers & QUALview)
309 #line 125 "selector.pcc"
312 L8:;
313 #line 126 "selector.pcc"
314 if (cons->view_predicate == NOexp)
315 { error("%Lview case for constructor %s is undefined\n",cons->name);
316 return NOexp;
318 return cons->view_predicate;
320 #line 131 "selector.pcc"
321 } else {
323 L9:;
324 if (
325 #line 139 "selector.pcc"
326 (((! normalized) && (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->tyvars == nil_1_)) && (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->arg > 1))
327 #line 139 "selector.pcc"
330 L10:;
331 #line 140 "selector.pcc"
332 return IDexp(Quark("a_",((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->id,"::tag_",mangle(cons->name)));
334 #line 141 "selector.pcc"
335 } else {
337 L11:;
338 #line 143 "selector.pcc"
339 int this_tag = tag_of(cons) + (normalized ? ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->unit : 0);
340 return LITERALexp(INTlit(this_tag));
341 #line 144 "selector.pcc"
344 } break;
345 default: {
346 L12:;
347 #line 145 "selector.pcc"
348 return NOexp;
349 #line 145 "selector.pcc"
350 } break;
352 } else { goto L12; }
353 } else {
354 if (cons->alg_ty) {
355 switch (cons->alg_ty->tag__) {
356 case a_Ty::tag_TYCONty: {
357 if (boxed(((Ty_TYCONty *)cons->alg_ty)->_1)) {
358 switch (((Ty_TYCONty *)cons->alg_ty)->_1->tag__) {
359 case a_TyCon::tag_DATATYPEtycon: {
360 if (
361 #line 125 "selector.pcc"
362 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->qualifiers & QUALview)
363 #line 125 "selector.pcc"
365 goto L8; } else {
367 L13:;
368 if (
369 #line 133 "selector.pcc"
370 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->arg == 0)
371 #line 133 "selector.pcc"
374 L14:;
375 #line 134 "selector.pcc"
376 return IDexp(mangle(cons->name));
377 #line 134 "selector.pcc"
378 } else {
380 L15:;
381 #line 136 "selector.pcc"
382 return CASTexp(integer_ty,IDexp(mangle(cons->name)));
383 #line 136 "selector.pcc"
386 } break;
387 default: { goto L12; } break;
389 } else { goto L12; }
390 } break;
391 default: { goto L6; } break;
393 } else { goto L6; }
395 } break;
396 default: {
397 L16:;
398 if (cons->ty) { goto L12; } else {
399 L17:;
400 if (cons->alg_ty) {
401 switch (cons->alg_ty->tag__) {
402 case a_Ty::tag_TYCONty: {
403 L18:;
404 if (boxed(((Ty_TYCONty *)cons->alg_ty)->_1)) {
405 switch (((Ty_TYCONty *)cons->alg_ty)->_1->tag__) {
406 case a_TyCon::tag_DATATYPEtycon: { goto L13; } break;
407 default: { goto L12; } break;
409 } else { goto L12; }
410 } break;
411 default: { goto L12; } break;
413 } else { goto L12; }
415 } break;
417 } else { goto L16; }
418 } else { goto L12; }
420 #line 146 "selector.pcc"
421 #line 146 "selector.pcc"
425 ///////////////////////////////////////////////////////////////////////////////
427 // Method to extract the tag from a term
429 ///////////////////////////////////////////////////////////////////////////////
430 Exp MatchCompiler::untag(Exp e, Ty ty)
432 #line 155 "selector.pcc"
433 #line 166 "selector.pcc"
435 Ty _V4 = deref(ty);
436 if (_V4) {
437 switch (_V4->tag__) {
438 case a_Ty::tag_TYCONty: {
439 if (boxed(((Ty_TYCONty *)_V4)->_1)) {
440 switch (((Ty_TYCONty *)_V4)->_1->tag__) {
441 case a_TyCon::tag_DATATYPEtycon: {
442 if (
443 #line 157 "selector.pcc"
444 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->qualifiers & QUALview)
445 #line 157 "selector.pcc"
448 #line 158 "selector.pcc"
449 if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->view_match == NOexp)
450 { error("%Lview test for datatype %T is undefined\n", ty);
451 return NOexp;
453 return subst(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->view_match,&e);
455 #line 163 "selector.pcc"
456 } else {
458 if (
459 #line 164 "selector.pcc"
460 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->arg > 0)
461 #line 164 "selector.pcc"
464 #line 165 "selector.pcc"
465 return APPexp(IDexp(
466 #line 165 "selector.pcc"
467 #line 165 "selector.pcc"
468 _s_e_l_e_c_t_o_rco_c_c_Q4
469 #line 165 "selector.pcc"
470 #line 165 "selector.pcc"
471 ),e);
472 #line 165 "selector.pcc"
473 } else {
475 L19:;
476 #line 166 "selector.pcc"
477 return e;
478 #line 166 "selector.pcc"
481 } break;
482 default: { goto L19; } break;
484 } else { goto L19; }
485 } break;
486 default: { goto L19; } break;
488 } else { goto L19; }
490 #line 167 "selector.pcc"
491 #line 167 "selector.pcc"
495 ///////////////////////////////////////////////////////////////////////////////
497 // Method to extract the tag from a term (optimized for arg/unit constructors)
499 ///////////////////////////////////////////////////////////////////////////////
500 Exp MatchCompiler::untag_one (Exp e, Cons c)
502 #line 176 "selector.pcc"
503 #line 197 "selector.pcc"
505 if (c) {
506 if (c->alg_ty) {
507 switch (c->alg_ty->tag__) {
508 case a_Ty::tag_TYCONty: {
509 if (c->ty) {
510 if (boxed(((Ty_TYCONty *)c->alg_ty)->_1)) {
511 switch (((Ty_TYCONty *)c->alg_ty)->_1->tag__) {
512 case a_TyCon::tag_DATATYPEtycon: {
513 L20:;
514 if (
515 #line 179 "selector.pcc"
516 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->qualifiers & QUALview)
517 #line 179 "selector.pcc"
520 L21:;
521 #line 180 "selector.pcc"
522 if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->view_match == NOexp)
523 { error("%Lview test for constructor %s is undefined\n",c->name);
524 return NOexp;
526 return subst(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->view_match,&e);
528 #line 185 "selector.pcc"
529 } else {
531 L22:;
532 #line 192 "selector.pcc"
533 if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->opt & OPTtaggedpointer) e = APPexp(IDexp(
534 #line 192 "selector.pcc"
535 #line 192 "selector.pcc"
536 _s_e_l_e_c_t_o_rco_c_c_Q5
537 #line 192 "selector.pcc"
538 #line 192 "selector.pcc"
539 ),e);
540 else if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->opt & OPTtagless) e = LITERALexp(INTlit(0));
541 else e = ARROWexp(e,
542 #line 194 "selector.pcc"
543 #line 194 "selector.pcc"
544 _s_e_l_e_c_t_o_rco_c_c_Q6
545 #line 194 "selector.pcc"
546 #line 194 "selector.pcc"
548 return e;
550 #line 196 "selector.pcc"
552 } break;
553 default: {
554 L23:;
555 #line 197 "selector.pcc"
556 return NOexp;
557 #line 197 "selector.pcc"
558 } break;
560 } else { goto L23; }
561 } else {
562 if (c->alg_ty) {
563 switch (c->alg_ty->tag__) {
564 case a_Ty::tag_TYCONty: {
565 if (boxed(((Ty_TYCONty *)c->alg_ty)->_1)) {
566 switch (((Ty_TYCONty *)c->alg_ty)->_1->tag__) {
567 case a_TyCon::tag_DATATYPEtycon: {
568 if (
569 #line 179 "selector.pcc"
570 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->qualifiers & QUALview)
571 #line 179 "selector.pcc"
573 goto L21; } else {
575 L24:;
576 if (
577 #line 187 "selector.pcc"
578 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->arg == 0)
579 #line 187 "selector.pcc"
582 L25:;
583 #line 188 "selector.pcc"
584 return e;
585 #line 188 "selector.pcc"
586 } else {
588 L26:;
589 #line 190 "selector.pcc"
590 return CASTexp(integer_ty,e);
591 #line 190 "selector.pcc"
594 } break;
595 default: { goto L26; } break;
597 } else { goto L26; }
598 } break;
599 default: {
600 L27:;
601 if (boxed(((Ty_TYCONty *)c->alg_ty)->_1)) {
602 switch (((Ty_TYCONty *)c->alg_ty)->_1->tag__) {
603 case a_TyCon::tag_DATATYPEtycon: {
604 L28:;
605 if (
606 #line 179 "selector.pcc"
607 (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)c->alg_ty)->_1)->qualifiers & QUALview)
608 #line 179 "selector.pcc"
610 goto L21; } else {
611 goto L26; }
612 } break;
613 default: { goto L26; } break;
615 } else { goto L26; }
616 } break;
618 } else { goto L27; }
620 } break;
621 default: {
622 L29:;
623 if (c->ty) { goto L23; } else {
624 L30:;
625 if (c->alg_ty) {
626 switch (c->alg_ty->tag__) {
627 case a_Ty::tag_TYCONty: {
628 L31:;
629 if (boxed(((Ty_TYCONty *)c->alg_ty)->_1)) {
630 switch (((Ty_TYCONty *)c->alg_ty)->_1->tag__) {
631 case a_TyCon::tag_DATATYPEtycon: { goto L24; } break;
632 default: { goto L26; } break;
634 } else { goto L26; }
635 } break;
636 default: { goto L26; } break;
638 } else { goto L26; }
640 } break;
642 } else { goto L29; }
643 } else { goto L23; }
645 #line 198 "selector.pcc"
646 #line 198 "selector.pcc"
649 #line 200 "selector.pcc"
651 ------------------------------- Statistics -------------------------------
652 Merge matching rules = yes
653 Number of DFA nodes merged = 1358
654 Number of ifs generated = 40
655 Number of switches generated = 24
656 Number of labels = 31
657 Number of gotos = 47
658 Adaptive matching = enabled
659 Fast string matching = disabled
660 Inline downcasts = enabled
661 --------------------------------------------------------------------------