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
9 ///////////////////////////////////////////////////////////////////////////////
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 ///////////////////////////////////////////////////////////////////////////////
28 #include <AD/strings/quark.h>
35 ///////////////////////////////////////////////////////////////////////////////
37 // Method to compute the proper selector into a component argument
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
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
56 Bool use_projection
= component
!= 0;
58 #line 39 "selector.pcc"
59 #line 110 "selector.pcc"
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
: {
69 #line 43 "selector.pcc"
70 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->qualifiers
& QUALview
)
71 #line 43 "selector.pcc"
74 #line 44 "selector.pcc"
78 #line 46 "selector.pcc"
79 #line 52 "selector.pcc"
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"
95 #line 52 "selector.pcc"
97 #line 52 "selector.pcc"
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"
108 default: { goto L1
; } break;
112 default: { goto L1
; } break;
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
);
125 result
= subst(selector_exp
,&e
);
127 #line 61 "selector.pcc"
130 #line 68 "selector.pcc"
134 #line 70 "selector.pcc"
135 #line 72 "selector.pcc"
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
: {
145 #line 71 "selector.pcc"
147 #line 71 "selector.pcc"
151 #line 72 "selector.pcc"
153 #line 72 "selector.pcc"
157 switch ((int)((Ty_TYCONty
*)_V2
)->_1
) {
158 case ((int)TUPLEtycon
): { goto L2
; } break;
159 default: { goto L3
; } break;
163 default: { goto L3
; } break;
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"
183 if ((((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->opt
& OPTtaggedpointer
) && c
->tag
!= 0)
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"
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
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"
202 #line 90 "selector.pcc"
203 #line 90 "selector.pcc"
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"
213 #line 92 "selector.pcc"
214 #line 92 "selector.pcc"
216 #line 92 "selector.pcc"
217 #line 92 "selector.pcc"
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
);
226 switch (_V3
->tag__
) {
227 case a_Ty::tag_TYCONty
: {
228 #line 96 "selector.pcc"
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"
242 #line 99 "selector.pcc"
243 bug("%Lmake_select");
244 #line 99 "selector.pcc"
249 #line 100 "selector.pcc"
250 #line 100 "selector.pcc"
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"
261 if (simple
) result
= ARROWexp(downcast_exp
,nm
);
262 else result
= DEREFexp(downcast_exp
);
266 #line 108 "selector.pcc"
274 default: { goto L5
; } break;
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"
298 switch (cons
->alg_ty
->tag__
) {
299 case a_Ty::tag_TYCONty
: {
302 if (boxed(((Ty_TYCONty
*)cons
->alg_ty
)->_1
)) {
303 switch (((Ty_TYCONty
*)cons
->alg_ty
)->_1
->tag__
) {
304 case a_TyCon::tag_DATATYPEtycon
: {
307 #line 125 "selector.pcc"
308 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)cons
->alg_ty
)->_1
)->qualifiers
& QUALview
)
309 #line 125 "selector.pcc"
313 #line 126 "selector.pcc"
314 if (cons
->view_predicate
== NOexp
)
315 { error("%Lview case for constructor %s is undefined\n",cons
->name
);
318 return cons
->view_predicate
;
320 #line 131 "selector.pcc"
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"
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"
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"
347 #line 145 "selector.pcc"
349 #line 145 "selector.pcc"
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
: {
361 #line 125 "selector.pcc"
362 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)cons
->alg_ty
)->_1
)->qualifiers
& QUALview
)
363 #line 125 "selector.pcc"
369 #line 133 "selector.pcc"
370 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)cons
->alg_ty
)->_1
)->arg
== 0)
371 #line 133 "selector.pcc"
375 #line 134 "selector.pcc"
376 return IDexp(mangle(cons
->name
));
377 #line 134 "selector.pcc"
381 #line 136 "selector.pcc"
382 return CASTexp(integer_ty
,IDexp(mangle(cons
->name
)));
383 #line 136 "selector.pcc"
387 default: { goto L12
; } break;
391 default: { goto L6
; } break;
398 if (cons
->ty
) { goto L12
; } else {
401 switch (cons
->alg_ty
->tag__
) {
402 case a_Ty::tag_TYCONty
: {
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;
411 default: { goto L12
; } break;
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"
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
: {
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
);
453 return subst(((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)_V4
)->_1
)->view_match
,&e
);
455 #line 163 "selector.pcc"
459 #line 164 "selector.pcc"
460 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)_V4
)->_1
)->arg
> 0)
461 #line 164 "selector.pcc"
464 #line 165 "selector.pcc"
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"
472 #line 165 "selector.pcc"
476 #line 166 "selector.pcc"
478 #line 166 "selector.pcc"
482 default: { goto L19
; } break;
486 default: { goto L19
; } break;
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"
507 switch (c
->alg_ty
->tag__
) {
508 case a_Ty::tag_TYCONty
: {
510 if (boxed(((Ty_TYCONty
*)c
->alg_ty
)->_1
)) {
511 switch (((Ty_TYCONty
*)c
->alg_ty
)->_1
->tag__
) {
512 case a_TyCon::tag_DATATYPEtycon
: {
515 #line 179 "selector.pcc"
516 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->qualifiers
& QUALview
)
517 #line 179 "selector.pcc"
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
);
526 return subst(((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->view_match
,&e
);
528 #line 185 "selector.pcc"
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"
540 else if (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->opt
& OPTtagless
) e
= LITERALexp(INTlit(0));
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"
550 #line 196 "selector.pcc"
555 #line 197 "selector.pcc"
557 #line 197 "selector.pcc"
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
: {
569 #line 179 "selector.pcc"
570 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->qualifiers
& QUALview
)
571 #line 179 "selector.pcc"
577 #line 187 "selector.pcc"
578 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->arg
== 0)
579 #line 187 "selector.pcc"
583 #line 188 "selector.pcc"
585 #line 188 "selector.pcc"
589 #line 190 "selector.pcc"
590 return CASTexp(integer_ty
,e
);
591 #line 190 "selector.pcc"
595 default: { goto L26
; } break;
601 if (boxed(((Ty_TYCONty
*)c
->alg_ty
)->_1
)) {
602 switch (((Ty_TYCONty
*)c
->alg_ty
)->_1
->tag__
) {
603 case a_TyCon::tag_DATATYPEtycon
: {
606 #line 179 "selector.pcc"
607 (((TyCon_DATATYPEtycon
*)((Ty_TYCONty
*)c
->alg_ty
)->_1
)->qualifiers
& QUALview
)
608 #line 179 "selector.pcc"
613 default: { goto L26
; } break;
623 if (c
->ty
) { goto L23
; } else {
626 switch (c
->alg_ty
->tag__
) {
627 case a_Ty::tag_TYCONty
: {
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;
636 default: { goto L26
; } break;
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
658 Adaptive matching = enabled
659 Fast string matching = disabled
660 Inline downcasts = enabled
661 --------------------------------------------------------------------------