?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merge remote branch 'master'
[prop.git] / prop-src / funmap.cc
blob76999703b04b43766206f69f50f3a3850d359cb9
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 "funmap.pcc".
5 ///////////////////////////////////////////////////////////////////////////////
6
7 #define PROP_QUARK_USED
8 #include <propdefs.h>
9 ///////////////////////////////////////////////////////////////////////////////
10 // Quark literals
11 ///////////////////////////////////////////////////////////////////////////////
12 static const Quark _f_u_n_m_a_pco_c_c_Q3("##");
13 static const Quark _f_u_n_m_a_pco_c_c_Q4("$$");
14 static const Quark _f_u_n_m_a_pco_c_c_Q1("#");
15 static const Quark _f_u_n_m_a_pco_c_c_Q2("$");
16 #line 1 "funmap.pcc"
17 ///////////////////////////////////////////////////////////////////////////////
18 //
19 // This file implements the FunctorMap data structure
20 //
21 ///////////////////////////////////////////////////////////////////////////////
22 #include <iostream>
23 #include <strstream>
24 #include <AD/automata/treegram.h>
25 #include <AD/automata/treegen.h>
26 #include <AD/rewrite/burs_gen.h>
27 #include <AD/strings/quark.h>
28 #include "funmap.h"
29 #include "ir.h"
30 #include "ast.h"
31 #include "matchcom.h"
32 #include "type.h"
33 #include "hashtab.h"
34 #include "datagen.h"
35 #include "config.h"
36 #include "rwgen.h"
37 #include "options.h"
38 #include "list.h"
39
40 ///////////////////////////////////////////////////////////////////////////////
41 //
42 // Import some type definitions from the tree grammar and hash table
43 // classes.
44 //
45 ///////////////////////////////////////////////////////////////////////////////
46 typedef TreeGrammar::TreeProduction TreeProduction;
47 typedef TreeGrammar::Cost TreeCost;
48 typedef HashTable::Key Key;
49 typedef HashTable::Value Value;
50
51 ///////////////////////////////////////////////////////////////////////////////
52 //
53 // Instantiate the vector id type
54 //
55 ///////////////////////////////////////////////////////////////////////////////
56 #line 40 "funmap.pcc"
57 #line 40 "funmap.pcc"
58 ///////////////////////////////////////////////////////////////////////////////
59 //
60 // Interface specification of datatype VectorId
61 //
62 ///////////////////////////////////////////////////////////////////////////////
63 #line 40 "funmap.pcc"
64
65
66 ///////////////////////////////////////////////////////////////////////////////
67 //
68 // Instantiation of datatype VectorId
69 //
70 ///////////////////////////////////////////////////////////////////////////////
71 #line 40 "funmap.pcc"
72 a_VectorId::a_VectorId (Cons x_cons, Ty x_ty, int x_arity)
73 : cons(x_cons), ty(x_ty), arity(x_arity)
74 {
75 }
76 a_VectorId * vector_id (Cons x_cons, Ty x_ty, int x_arity)
77 {
78 return new a_VectorId (x_cons, x_ty, x_arity);
79 }
80
81
82 #line 40 "funmap.pcc"
83 #line 40 "funmap.pcc"
84
85
86 ///////////////////////////////////////////////////////////////////////////////
87 //
88 // Hashing and equality on vector id's
89 //
90 ///////////////////////////////////////////////////////////////////////////////
91 unsigned int vector_id_hash(HashTable::Key k)
92 { VectorId id = (VectorId)k;
93 return (unsigned int)id->cons + ty_hash(id->ty) + id->arity;
94 }
95 Bool vector_id_equal(HashTable::Key a, HashTable::Key b)
96 { VectorId x = (VectorId)a;
97 VectorId y = (VectorId)b;
98 return x->cons == y->cons && x->arity == y->arity && ty_equal(x->ty,y->ty);
99 }
100
101 ///////////////////////////////////////////////////////////////////////////////
102 //
103 // Method to decorate cost expression and attribute bindings for
104 // a pattern.
105 //
106 ///////////////////////////////////////////////////////////////////////////////
107 int decor_rewrite (Pat pat, int rule, int kid, PatternVarEnv& E)
108 {
109 #line 64 "funmap.pcc"
110 #line 91 "funmap.pcc"
111 {
112 for (;;) {
113 if (pat) {
114 switch (pat->tag__) {
115 case a_Pat::tag_APPpat: {
116 #line 69 "funmap.pcc"
117 pat = ((Pat_APPpat *)pat)->_2;
118 #line 69 "funmap.pcc"
119 } break;
120 case a_Pat::tag_TYPEDpat: {
121 #line 67 "funmap.pcc"
122 pat = ((Pat_TYPEDpat *)pat)->_1;
123 #line 67 "funmap.pcc"
124 } break;
125 case a_Pat::tag_ASpat: {
126 #line 83 "funmap.pcc"
127 Id attrib_name =
128 #line 83 "funmap.pcc"
129 #line 83 "funmap.pcc"
130 _f_u_n_m_a_pco_c_c_Q1
131 #line 83 "funmap.pcc"
132 #line 83 "funmap.pcc"
133 + ((Pat_ASpat *)pat)->_1;
134 Id cost_name =
135 #line 84 "funmap.pcc"
136 #line 84 "funmap.pcc"
137 _f_u_n_m_a_pco_c_c_Q2
138 #line 84 "funmap.pcc"
139 #line 84 "funmap.pcc"
140 + ((Pat_ASpat *)pat)->_1;
141 Ty ty = mkvar();
142 E.add (attrib_name, SYNexp(kid, rule, mkvar(),true), ty, ISpositive);
143 E.add (cost_name, COSTexp(kid), ty, ISpositive);
144 kid = kid+1;
145 pat = ((Pat_ASpat *)pat)->_2;
146
147 #line 90 "funmap.pcc"
148 } break;
149 case a_Pat::tag_CONTEXTpat: {
150 #line 70 "funmap.pcc"
151 pat = ((Pat_CONTEXTpat *)pat)->_2;
152 #line 70 "funmap.pcc"
153 } break;
154 case a_Pat::tag_TUPLEpat: {
155 #line 72 "funmap.pcc"
156 return decor_rewrite(((Pat_TUPLEpat *)pat)->TUPLEpat, rule, kid, E);
157 #line 72 "funmap.pcc"
158 } break;
159 case a_Pat::tag_LISTpat: {
160 #line 74 "funmap.pcc"
161 kid = decor_rewrite(((Pat_LISTpat *)pat)->head, rule, kid, E); pat = ((Pat_LISTpat *)pat)->tail;
162 #line 74 "funmap.pcc"
163 } break;
164 case a_Pat::tag_VECTORpat: {
165 #line 76 "funmap.pcc"
166 kid = decor_rewrite(((Pat_VECTORpat *)pat)->elements, rule,
167 decor_rewrite(((Pat_VECTORpat *)pat)->array, rule, kid, E), E);
168 if (((Pat_VECTORpat *)pat)->head_flex || ((Pat_VECTORpat *)pat)->tail_flex)
169 error("%Lflexible vector pattern currently not supported in rewriting: %p\n", pat);
170 pat = ((Pat_VECTORpat *)pat)->len;
171
172 #line 81 "funmap.pcc"
173 } break;
174 case a_Pat::tag_GUARDpat: {
175 #line 68 "funmap.pcc"
176 pat = ((Pat_GUARDpat *)pat)->_1;
177 #line 68 "funmap.pcc"
178 } break;
179 case a_Pat::tag_MARKEDpat: {
180 #line 66 "funmap.pcc"
181 pat = ((Pat_MARKEDpat *)pat)->_2;
182 #line 66 "funmap.pcc"
183 } break;
184 case a_Pat::tag_CONSpat:
185 case a_Pat::tag_LITERALpat: {
186 L2:;
187 #line 65 "funmap.pcc"
188 return kid;
189 #line 65 "funmap.pcc"
190 } break;
191 default: {
192 #line 91 "funmap.pcc"
193 return kid;
194 #line 91 "funmap.pcc"
195 } break;
196 }
197 } else { goto L2; }
198 }
199 }
200 #line 92 "funmap.pcc"
201 #line 92 "funmap.pcc"
202
203 }
204
205 ///////////////////////////////////////////////////////////////////////////////
206 //
207 // Decorate a pattern list.
208 //
209 ///////////////////////////////////////////////////////////////////////////////
210 int decor_rewrite (Pats pats, int rule, int kid, PatternVarEnv& E)
211 { for_each (Pat, p, pats) kid = decor_rewrite(p, rule, kid, E);
212 return kid;
213 }
214
215 ///////////////////////////////////////////////////////////////////////////////
216 //
217 // Decorate rewriting patterns.
218 //
219 ///////////////////////////////////////////////////////////////////////////////
220 int decor_rewrite (Pat pat, int rule, PatternVarEnv& E)
221 { Ty ty = mkvar();
222 E.add (
223 #line 112 "funmap.pcc"
224 #line 112 "funmap.pcc"
225 _f_u_n_m_a_pco_c_c_Q3
226 #line 112 "funmap.pcc"
227 #line 112 "funmap.pcc"
228 , THISSYNexp(rule,mkvar(),true), ty, ISpositive);
229 E.add (
230 #line 113 "funmap.pcc"
231 #line 113 "funmap.pcc"
232 _f_u_n_m_a_pco_c_c_Q4
233 #line 113 "funmap.pcc"
234 #line 113 "funmap.pcc"
235 , THISCOSTexp(), ty, ISpositive);
236 return decor_rewrite (pat, rule, 0, E);
237 }
238
239 ///////////////////////////////////////////////////////////////////////////////
240 //
241 // Constructor of the functor mapping table.
242 //
243 ///////////////////////////////////////////////////////////////////////////////
244 FunctorMap::FunctorMap(Id name, MatchRules rules)
245 : literal_map(literal_hash,literal_equal,129),
246 var_map (string_hash,string_equal),
247 type_map (ty_hash,ty_equal),
248 vector_map (vector_id_hash,vector_id_equal),
249 rule_map (ty_hash,ty_equal),
250 topdown_rule_map (ty_hash,ty_equal),
251 before_rule_map (ty_hash,ty_equal),
252 preorder_rule_map (ty_hash,ty_equal),
253 postorder_rule_map (ty_hash,ty_equal),
254 protocols (ty_hash,ty_equal),
255 nonterm_map(string_hash,string_equal),
256 nonterm_rules(string_hash,string_equal),
257 nonterm_rules_bits(string_hash,string_equal),
258 chain_rules(string_hash,string_equal),
259 bottomup_rules(
260 #line 137 "funmap.pcc"
261 #line 137 "funmap.pcc"
262 nil_1_
263 #line 137 "funmap.pcc"
264 #line 137 "funmap.pcc"
265 )
266 {
267 ///////////////////////////////////////////////////////////////////////////
268 //
269 // Initialize the internals.
270 //
271 ///////////////////////////////////////////////////////////////////////////
272 class_name = name;
273 N = length(rules);
274 functors = 0;
275 variables = 0;
276 tree_gen = 0;
277 topdown_gen = 0;
278 use_compression = true;
279 has_guard = false;
280 has_replacement = false;
281 has_cost = false;
282 has_cost_exp = false;
283 has_syn_attrib = false;
284 is_applicative = false;
285 gen_reducers = false;
286 dynamic_search = false;
287 max_arity = 1;
288 functor_names = 0;
289 variable_names = 0;
290 is_ok = true;
291
292 rule_maps[MatchRuleInfo::BOTTOMUP] = &rule_map;
293 rule_maps[MatchRuleInfo::TOPDOWN] = &topdown_rule_map;
294 rule_maps[MatchRuleInfo::BEFORE] = &before_rule_map;
295 rule_maps[MatchRuleInfo::PREORDER] = &preorder_rule_map;
296 rule_maps[MatchRuleInfo::POSTORDER] = &postorder_rule_map;
297
298 TyQual qual = RewritingCompiler::lookup_qual(class_name);
299 if (qual & QUALtreeparser) gen_reducers = true;
300 if (qual & QUALapplicative) is_applicative = true;
301
302 int last_errors = errors;
303 enter_protocols(); // enter the protocols
304 // partition rule by type
305 bottomup_rules = partition_rules(rules);
306 check_for_missing_protocols();
307 if (errors != last_errors) { is_ok = false; return; }
308 build_tree_grammar(bottomup_rules);
309
310 // BUG fix, always use dynamic search algorithm when treeparser
311 // mode is on, since the class interface has to match.
312 //dynamic_search = gen_reducers && (has_cost || has_cost_exp);
313 dynamic_search = gen_reducers;
314 }
315
316 ///////////////////////////////////////////////////////////////////////////////
317 //
318 // Method to enter the protocols into the protocol map
319 //
320 ///////////////////////////////////////////////////////////////////////////////
321 void FunctorMap::enter_protocols ()
322 { Protocols Ps = RewritingCompiler::lookup_protocols(class_name);
323 { for_each (Protocol, p, Ps)
324 {
325 #line 196 "funmap.pcc"
326 #line 200 "funmap.pcc"
327 {
328 #line 198 "funmap.pcc"
329 encode(p->ty); protocols.insert(p->ty,p);
330 if (p->syn != NOty) has_syn_attrib = true;
331
332 #line 200 "funmap.pcc"
333 }
334 #line 201 "funmap.pcc"
335 #line 201 "funmap.pcc"
336
337 }
338 }
339 }
340
341
342 ///////////////////////////////////////////////////////////////////////////////
343 //
344 // Checks for missing protocol
345 //
346 ///////////////////////////////////////////////////////////////////////////////
347 void FunctorMap::check_for_missing_protocols()
348 { foreach_entry (e, type_map)
349 { Ty ty = Ty(type_map.key(e));
350 if (! protocols.contains(ty))
351 { error("%Lmissing type %T in the traversal list of rewrite class %s\n",
352 ty, class_name);
353 }
354 }
355 }
356
357 ///////////////////////////////////////////////////////////////////////////////
358 //
359 // Otherwise, build the tree grammar and the functor/variable name maps.
360 //
361 ///////////////////////////////////////////////////////////////////////////////
362 void FunctorMap::build_tree_grammar (MatchRules rules)
363 {
364 N = length(rules);
365 TreeProduction * Ps =
366 (TreeProduction *)mem_pool.c_alloc(sizeof(TreeProduction) * N);
367
368 ////////////////////////////////////////////////////////////////////////////
369 //
370 // Translate patterns into terms
371 //
372 ////////////////////////////////////////////////////////////////////////////
373 { int i = 0;
374 for_each (MatchRule, r, rules)
375 {
376 #line 240 "funmap.pcc"
377 #line 255 "funmap.pcc"
378 {
379 #line 242 "funmap.pcc"
380 int rule_no = r->_1 ? var_map[r->_1] : 0;
381 int cst;
382
383 #line 244 "funmap.pcc"
384 #line 247 "funmap.pcc"
385 {
386 Cost _V1 = r->_4;
387 if (_V1) {
388 if (untagp(_V1)) {
389
390 #line 246 "funmap.pcc"
391 cst = ((Cost_INTcost *)derefp(_V1))->INTcost; has_cost = true;
392 #line 246 "funmap.pcc"
393 } else {
394
395 #line 247 "funmap.pcc"
396 cst = 0; has_cost_exp = true;
397 #line 247 "funmap.pcc"
398 }
399 } else {
400 #line 245 "funmap.pcc"
401 cst = 0;
402 #line 245 "funmap.pcc"
403 }
404 }
405 #line 248 "funmap.pcc"
406 #line 248 "funmap.pcc"
407
408 Ps[i] = TreeProduction(rule_no,trans(r->_2),cst);
409 if (r->_3 != NOexp || (r->option & MatchRuleInfo::FAILREWRITE))
410 has_guard = true;
411 if (r->option & MatchRuleInfo::REPLACEMENT)
412 has_replacement = true;
413 i++;
414
415 #line 255 "funmap.pcc"
416 }
417 #line 256 "funmap.pcc"
418 #line 256 "funmap.pcc"
419
420 }
421 }
422
423 ////////////////////////////////////////////////////////////////////////////
424 //
425 // Compute the functor/variable names
426 //
427 ////////////////////////////////////////////////////////////////////////////
428 compute_names();
429
430 ////////////////////////////////////////////////////////////////////////////
431 //
432 // Compile the tree grammar
433 //
434 ////////////////////////////////////////////////////////////////////////////
435 G.compile (N, Ps, functor_names, variable_names, 0, functors - 1, 0);
436 }
437
438 ///////////////////////////////////////////////////////////////////////////////
439 //
440 // Method to convert literal patterns inside a set of matching rules
441 // into guards
442 //
443 ///////////////////////////////////////////////////////////////////////////////
444 void FunctorMap::make_guard (MatchRules rules)
445 {
446 #line 282 "funmap.pcc"
447 #line 286 "funmap.pcc"
448 {
449 for (;;) {
450 if (rules) {
451 #line 284 "funmap.pcc"
452 rules->_1->_2 = make_guard(rules->_1->_2, rules->_1->_3);
453 rules = rules->_2;
454
455 #line 286 "funmap.pcc"
456 } else { goto L3; }
457 }
458 L3:;
459 }
460 #line 287 "funmap.pcc"
461 #line 287 "funmap.pcc"
462
463 }
464
465 ///////////////////////////////////////////////////////////////////////////////
466 //
467 // Method to convert literal patterns into guards.
468 //
469 ///////////////////////////////////////////////////////////////////////////////
470 Pat FunctorMap::make_guard (Pat pat, Exp& e)
471 { Pat new_pat;
472 // return pat; // BUG fix
473
474 #line 298 "funmap.pcc"
475 #line 323 "funmap.pcc"
476 {
477 if (pat) {
478 switch (pat->tag__) {
479 case a_Pat::tag_APPpat: {
480 #line 304 "funmap.pcc"
481 new_pat = APPpat(make_guard(((Pat_APPpat *)pat)->_1,e),make_guard(((Pat_APPpat *)pat)->_2,e));
482 #line 304 "funmap.pcc"
483 } break;
484 case a_Pat::tag_TYPEDpat: {
485 #line 300 "funmap.pcc"
486 new_pat = TYPEDpat(make_guard(((Pat_TYPEDpat *)pat)->_1,e),((Pat_TYPEDpat *)pat)->_2);
487 #line 300 "funmap.pcc"
488 } break;
489 case a_Pat::tag_ASpat: {
490 #line 299 "funmap.pcc"
491 new_pat = ASpat(((Pat_ASpat *)pat)->_1,make_guard(((Pat_ASpat *)pat)->_2,e),((Pat_ASpat *)pat)->_3,((Pat_ASpat *)pat)->_4);
492 #line 299 "funmap.pcc"
493 } break;
494 case a_Pat::tag_LITERALpat: {
495 switch (((Pat_LITERALpat *)pat)->LITERALpat->tag__) {
496 case a_Literal::tag_INTlit:
497 case a_Literal::tag_BOOLlit:
498 case a_Literal::tag_CHARlit:
499 case a_Literal::tag_REALlit: {
500 #line 306 "funmap.pcc"
501 Exp guard_exp = BINOPexp("==",pat->selector,LITERALexp(((Pat_LITERALpat *)pat)->LITERALpat));
502 e = e == NOexp ? guard_exp : BINOPexp("&&",e,guard_exp);
503 new_pat = WILDpat();
504
505 #line 309 "funmap.pcc"
506 } break;
507 default: {
508 L4:;
509 #line 323 "funmap.pcc"
510 new_pat = pat;
511 #line 323 "funmap.pcc"
512 } break;
513 }
514 } break;
515 case a_Pat::tag_TUPLEpat: {
516 #line 302 "funmap.pcc"
517 new_pat = TUPLEpat(make_guard(((Pat_TUPLEpat *)pat)->TUPLEpat,e));
518 #line 302 "funmap.pcc"
519 } break;
520 case a_Pat::tag_RECORDpat: {
521 #line 303 "funmap.pcc"
522 new_pat = RECORDpat(make_guard(((Pat_RECORDpat *)pat)->_1,e),((Pat_RECORDpat *)pat)->_2);
523 #line 303 "funmap.pcc"
524 } break;
525 case a_Pat::tag_LISTpat: {
526 #line 311 "funmap.pcc"
527 new_pat =
528 #line 311 "funmap.pcc"
529 #line 311 "funmap.pcc"
530 LISTpat(((Pat_LISTpat *)pat)->cons, ((Pat_LISTpat *)pat)->nil, make_guard(((Pat_LISTpat *)pat)->head,e), make_guard(((Pat_LISTpat *)pat)->tail,e))
531 #line 312 "funmap.pcc"
532 #line 312 "funmap.pcc"
533 ;
534
535 #line 313 "funmap.pcc"
536 } break;
537 case a_Pat::tag_VECTORpat: {
538 #line 315 "funmap.pcc"
539 new_pat =
540 #line 315 "funmap.pcc"
541 #line 315 "funmap.pcc"
542 VECTORpat(((Pat_VECTORpat *)pat)->cons, make_guard(((Pat_VECTORpat *)pat)->len,e), make_guard(((Pat_VECTORpat *)pat)->array,e), make_guard(((Pat_VECTORpat *)pat)->elements,e), ((Pat_VECTORpat *)pat)->head_flex, ((Pat_VECTORpat *)pat)->tail_flex)
543 #line 321 "funmap.pcc"
544 #line 321 "funmap.pcc"
545 ;
546
547 #line 322 "funmap.pcc"
548 } break;
549 case a_Pat::tag_MARKEDpat: {
550 #line 301 "funmap.pcc"
551 new_pat = MARKEDpat(((Pat_MARKEDpat *)pat)->_1,make_guard(((Pat_MARKEDpat *)pat)->_2,e));
552 #line 301 "funmap.pcc"
553 } break;
554 default: { goto L4; } break;
555 }
556 } else { goto L4; }
557 }
558 #line 324 "funmap.pcc"
559 #line 324 "funmap.pcc"
560
561 if (new_pat != pat && boxed(new_pat))
562 { new_pat->ty = pat->ty;
563 new_pat->selector = pat->selector;
564 }
565 return new_pat;
566 }
567
568 ///////////////////////////////////////////////////////////////////////////////
569 //
570 // Unguard a pattern list
571 //
572 ///////////////////////////////////////////////////////////////////////////////
573 Pats FunctorMap::make_guard (Pats ps, Exp& e)
574 {
575 #line 338 "funmap.pcc"
576 #line 340 "funmap.pcc"
577 {
578 if (ps) {
579 #line 340 "funmap.pcc"
580 return
581 #line 340 "funmap.pcc"
582 #line 340 "funmap.pcc"
583 list_1_(make_guard(ps->_1,e),make_guard(ps->_2,e))
584 #line 340 "funmap.pcc"
585 #line 340 "funmap.pcc"
586 ;
587 #line 340 "funmap.pcc"
588 } else {
589 #line 339 "funmap.pcc"
590 return
591 #line 339 "funmap.pcc"
592 #line 339 "funmap.pcc"
593 nil_1_
594 #line 339 "funmap.pcc"
595 #line 339 "funmap.pcc"
596 ;
597 #line 339 "funmap.pcc"
598 }
599 }
600 #line 341 "funmap.pcc"
601 #line 341 "funmap.pcc"
602
603 }
604
605 ///////////////////////////////////////////////////////////////////////////////
606 //
607 // Unguard a labeled pattern list
608 //
609 ///////////////////////////////////////////////////////////////////////////////
610 LabPats FunctorMap::make_guard (LabPats ps, Exp& e)
611 {
612 #line 350 "funmap.pcc"
613 #line 356 "funmap.pcc"
614 {
615 if (ps) {
616 #line 352 "funmap.pcc"
617 LabPat lab_pat;
618 lab_pat.label = ps->_1.label;
619 lab_pat.pat = make_guard(ps->_1.pat,e);
620 return
621 #line 355 "funmap.pcc"
622 #line 355 "funmap.pcc"
623 list_1_(lab_pat,make_guard(ps->_2,e))
624 #line 355 "funmap.pcc"
625 #line 355 "funmap.pcc"
626 ;
627
628 #line 356 "funmap.pcc"
629 } else {
630 #line 351 "funmap.pcc"
631 return
632 #line 351 "funmap.pcc"
633 #line 351 "funmap.pcc"
634 nil_1_
635 #line 351 "funmap.pcc"
636 #line 351 "funmap.pcc"
637 ;
638 #line 351 "funmap.pcc"
639 }
640 }
641 #line 357 "funmap.pcc"
642 #line 357 "funmap.pcc"
643
644 }
645
646 ///////////////////////////////////////////////////////////////////////////////
647 //
648 // Check whether we know of the type
649 //
650 ///////////////////////////////////////////////////////////////////////////////
651 Bool FunctorMap::is_known_type(Ty ty)
652 { return type_map.contains(ty) ||
653 ty_equal(ty, string_ty) ||
654 ty_equal(ty, quark_ty)
655 // ty_equal(ty, integer_ty) ||
656 // ty_equal(ty, bool_ty) ||
657 // ty_equal(ty, real_ty) ||
658 // ty_equal(ty, character_ty)
659 ;
660 }
661
662 ///////////////////////////////////////////////////////////////////////////////
663 //
664 // Check whether we the type is rewritable.
665 //
666 ///////////////////////////////////////////////////////////////////////////////
667 Bool FunctorMap::is_rewritable_type(Ty ty) { return type_map.contains(ty); }
668
669 ///////////////////////////////////////////////////////////////////////////////
670 //
671 // Method to assign variable encoding to a non-terminal
672 //
673 ///////////////////////////////////////////////////////////////////////////////
674 void FunctorMap::encode (Id id)
675 { if (! var_map.contains(id))
676 { ++variables; var_map.insert(id,variables);
677 }
678 }
679
680 ///////////////////////////////////////////////////////////////////////////////
681 //
682 // Method to assign functor encoding to a type
683 //
684 ///////////////////////////////////////////////////////////////////////////////
685 void FunctorMap::encode (Ty ty)
686 {
687 #line 400 "funmap.pcc"
688 #line 409 "funmap.pcc"
689 {
690 Ty _V2 = deref_all(ty);
691 if (_V2) {
692 switch (_V2->tag__) {
693 case a_Ty::tag_TYCONty: {
694 if (boxed(((Ty_TYCONty *)_V2)->_1)) {
695 switch (((Ty_TYCONty *)_V2)->_1->tag__) {
696 case a_TyCon::tag_DATATYPEtycon: {
697 #line 402 "funmap.pcc"
698 if (! type_map.contains(_V2))
699 { type_map.insert(_V2, functors);
700 functors += ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V2)->_1)->unit + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V2)->_1)->arg;
701 }
702
703 #line 406 "funmap.pcc"
704 } break;
705 default: {
706 L5:;
707 #line 407 "funmap.pcc"
708 for_each(Ty, ty, ((Ty_TYCONty *)_V2)->_2) encode(ty);
709 #line 407 "funmap.pcc"
710 } break;
711 }
712 } else { goto L5; }
713 } break;
714 default: {
715 L6:; } break;
716 }
717 } else { goto L6; }
718 }
719 #line 409 "funmap.pcc"
720 #line 409 "funmap.pcc"
721
722 }
723
724 ///////////////////////////////////////////////////////////////////////////////
725 //
726 // Method to assign functor encoding to a pattern.
727 // Assign a functor value to each distinct literal and pattern constructor.
728 //
729 ///////////////////////////////////////////////////////////////////////////////
730 void FunctorMap::encode(Pat pat)
731 {
732 #line 419 "funmap.pcc"
733 #line 480 "funmap.pcc"
734 {
735 for (;;) {
736 if (pat) {
737 switch (pat->tag__) {
738 case a_Pat::tag_CONSpat: {
739 if (((Pat_CONSpat *)pat)->CONSpat) {
740 if (((Pat_CONSpat *)pat)->CONSpat->alg_ty) {
741 switch (((Pat_CONSpat *)pat)->CONSpat->alg_ty->tag__) {
742 case a_Ty::tag_TYCONty: {
743 if (boxed(((Ty_TYCONty *)((Pat_CONSpat *)pat)->CONSpat->alg_ty)->_1)) {
744 switch (((Ty_TYCONty *)((Pat_CONSpat *)pat)->CONSpat->alg_ty)->_1->tag__) {
745 case a_TyCon::tag_DATATYPEtycon: {
746 #line 449 "funmap.pcc"
747 if (pat->ty != NOty && ! type_map.contains(pat->ty))
748 { type_map.insert(pat->ty, functors);
749 functors += ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Pat_CONSpat *)pat)->CONSpat->alg_ty)->_1)->unit + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Pat_CONSpat *)pat)->CONSpat->alg_ty)->_1)->arg;
750 }
751 return;
752
753 #line 454 "funmap.pcc"
754 } break;
755 default: {
756 L8:;
757 #line 480 "funmap.pcc"
758 error ("%LSorry: pattern not supported in rewriting: %p\n", pat); return;
759 #line 480 "funmap.pcc"
760 } break;
761 }
762 } else { goto L8; }
763 } break;
764 default: { goto L8; } break;
765 }
766 } else { goto L8; }
767 } else { goto L8; }
768 } break;
769 case a_Pat::tag_APPpat: {
770 #line 455 "funmap.pcc"
771 encode(pat->ty); pat = ((Pat_APPpat *)pat)->_2;
772 #line 455 "funmap.pcc"
773 } break;
774 case a_Pat::tag_TYPEDpat: {
775 #line 422 "funmap.pcc"
776 pat = ((Pat_TYPEDpat *)pat)->_1;
777 #line 422 "funmap.pcc"
778 } break;
779 case a_Pat::tag_ASpat: {
780 #line 421 "funmap.pcc"
781 pat = ((Pat_ASpat *)pat)->_2;
782 #line 421 "funmap.pcc"
783 } break;
784 case a_Pat::tag_LITERALpat: {
785 switch (((Pat_LITERALpat *)pat)->LITERALpat->tag__) {
786 case a_Literal::tag_BIGINTlit: { goto L8; } break;
787 case a_Literal::tag_STRINGlit:
788 case a_Literal::tag_REGEXPlit:
789 case a_Literal::tag_QUARKlit: {
790 #line 437 "funmap.pcc"
791 if (! literal_map.contains(((Pat_LITERALpat *)pat)->LITERALpat))
792 { literal_map.insert(((Pat_LITERALpat *)pat)->LITERALpat,functors);
793 functors++;
794 }
795 return;
796
797 #line 442 "funmap.pcc"
798 } break;
799 default: {
800 #line 444 "funmap.pcc"
801 bug ("%Luntransformed literal pattern %p found in rewriting\n",pat);
802 #line 444 "funmap.pcc"
803 } break;
804 }
805 } break;
806 case a_Pat::tag_TUPLEpat: {
807 #line 425 "funmap.pcc"
808 int i = 0;
809 for_each (Pat, p, ((Pat_TUPLEpat *)pat)->TUPLEpat) { i++; encode(p); }
810 if (max_arity < i) max_arity = i;
811 return;
812
813 #line 429 "funmap.pcc"
814 } break;
815 case a_Pat::tag_RECORDpat: {
816 #line 431 "funmap.pcc"
817 for_each (LabPat, p, ((Pat_RECORDpat *)pat)->_1) { encode(p.pat); }
818 int arity = arity_of(pat->ty);
819 if (max_arity < arity) max_arity = arity;
820 return;
821
822 #line 435 "funmap.pcc"
823 } break;
824 case a_Pat::tag_LISTpat: {
825 #line 457 "funmap.pcc"
826 Pat new_pat = CONSpat(((Pat_LISTpat *)pat)->nil);
827 new_pat->ty = pat->ty;
828 encode(new_pat);
829 for_each (Pat, i, ((Pat_LISTpat *)pat)->head) encode(i);
830 if (max_arity < 2) max_arity = 2;
831 pat = ((Pat_LISTpat *)pat)->tail;
832
833 #line 463 "funmap.pcc"
834 } break;
835 case a_Pat::tag_VECTORpat: {
836 #line 465 "funmap.pcc"
837 Pat new_pat = CONSpat(((Pat_VECTORpat *)pat)->cons);
838 new_pat->ty = pat->ty;
839 encode(new_pat);
840 for_each (Pat, p, ((Pat_VECTORpat *)pat)->elements) encode(p);
841 int l = length(((Pat_VECTORpat *)pat)->elements);
842 if (max_arity < l) max_arity = l;
843 if (pat->ty != NOty)
844 { VectorId vec_id = vector_id(((Pat_VECTORpat *)pat)->cons,pat->ty,l);
845 if ( ! vector_map.contains(vec_id))
846 { vector_map.insert(vec_id, functors);
847 functors++;
848 }
849 }
850 return;
851
852 #line 479 "funmap.pcc"
853 } break;
854 case a_Pat::tag_MARKEDpat: {
855 #line 423 "funmap.pcc"
856 pat = ((Pat_MARKEDpat *)pat)->_2;
857 #line 423 "funmap.pcc"
858 } break;
859 case a_Pat::tag_WILDpat:
860 case a_Pat::tag_IDpat: {
861 L9:;
862 #line 420 "funmap.pcc"
863 return;
864 #line 420 "funmap.pcc"
865 } break;
866 default: { goto L8; } break;
867 }
868 } else { goto L9; }
869 }
870 }
871 #line 481 "funmap.pcc"
872 #line 481 "funmap.pcc"
873
874 }
875
876 ///////////////////////////////////////////////////////////////////////////////
877 //
878 // Method to translate a pattern into a term.
879 //
880 ///////////////////////////////////////////////////////////////////////////////
881 TreeTerm FunctorMap::trans(Pat pat)
882 {
883 #line 490 "funmap.pcc"
884 #line 575 "funmap.pcc"
885 {
886 for (;;) {
887 if (pat) {
888 switch (pat->tag__) {
889 case a_Pat::tag_WILDpat: {
890 L11:;
891 #line 491 "funmap.pcc"
892 return wild_term;
893 #line 491 "funmap.pcc"
894 } break;
895 case a_Pat::tag_IDpat: {
896 #line 500 "funmap.pcc"
897 return var_map.contains(((Pat_IDpat *)pat)->_1) ? var_term(var_map[((Pat_IDpat *)pat)->_1]) : wild_term;
898
899 #line 501 "funmap.pcc"
900 } break;
901 case a_Pat::tag_CONSpat: {
902 if (((Pat_CONSpat *)pat)->CONSpat) {
903 #line 553 "funmap.pcc"
904 return new_term(mem_pool, type_map[pat->ty]+((Pat_CONSpat *)pat)->CONSpat->tag);
905 #line 553 "funmap.pcc"
906 } else {
907 L12:;
908 #line 575 "funmap.pcc"
909 error ("%LSorry: pattern not supported: %p\n", pat); return wild_term;
910 #line 575 "funmap.pcc"
911 }
912 } break;
913 case a_Pat::tag_APPpat: {
914 if (((Pat_APPpat *)pat)->_1) {
915 switch (((Pat_APPpat *)pat)->_1->tag__) {
916 case a_Pat::tag_CONSpat: {
917 if (((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat) {
918 if (((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty) {
919 switch (((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty->tag__) {
920 case a_Ty::tag_TYCONty: {
921 if (boxed(((Ty_TYCONty *)((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty)->_1)) {
922 switch (((Ty_TYCONty *)((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty)->_1->tag__) {
923 case a_TyCon::tag_DATATYPEtycon: {
924 #line 540 "funmap.pcc"
925 TreeTerm a = trans(((Pat_APPpat *)pat)->_2);
926
927 #line 541 "funmap.pcc"
928 #line 549 "funmap.pcc"
929 {
930 int _V4 = arity_of(((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->ty);
931 switch (_V4) {
932 case 1: {
933 #line 543 "funmap.pcc"
934 return new_term(mem_pool,type_map[pat->ty]+((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty)->_1)->unit+((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->tag,1,&a);
935
936 #line 544 "funmap.pcc"
937 } break;
938 default: {
939 if (a) {
940 switch (a->tag__) {
941 case a_TreeTerm::tag_tree_term: {
942 #line 546 "funmap.pcc"
943 ((TreeTerm_tree_term *)a)->_1 = type_map[pat->ty]+((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty)->_1)->unit+((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->tag; return a;
944 #line 546 "funmap.pcc"
945 } break;
946 default: {
947 L13:;
948 #line 548 "funmap.pcc"
949 return new_term(mem_pool, type_map[pat->ty]+((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->alg_ty)->_1)->unit+((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat->tag, _V4);
950
951 #line 549 "funmap.pcc"
952 } break;
953 }
954 } else { goto L13; }
955 }
956 }
957 }
958 #line 550 "funmap.pcc"
959 #line 550 "funmap.pcc"
960
961
962 #line 551 "funmap.pcc"
963 } break;
964 default: { goto L12; } break;
965 }
966 } else { goto L12; }
967 } break;
968 default: { goto L12; } break;
969 }
970 } else { goto L12; }
971 } else { goto L12; }
972 } break;
973 default: { goto L12; } break;
974 }
975 } else { goto L12; }
976 } break;
977 case a_Pat::tag_TYPEDpat: {
978 #line 493 "funmap.pcc"
979 pat = ((Pat_TYPEDpat *)pat)->_1;
980 #line 493 "funmap.pcc"
981 } break;
982 case a_Pat::tag_ASpat: {
983 #line 492 "funmap.pcc"
984 pat = ((Pat_ASpat *)pat)->_2;
985 #line 492 "funmap.pcc"
986 } break;
987 case a_Pat::tag_LITERALpat: {
988 switch (((Pat_LITERALpat *)pat)->LITERALpat->tag__) {
989 case a_Literal::tag_STRINGlit:
990 case a_Literal::tag_REGEXPlit:
991 case a_Literal::tag_QUARKlit: {
992 #line 496 "funmap.pcc"
993 return new_term(mem_pool,literal_map[((Pat_LITERALpat *)pat)->LITERALpat]);
994 #line 496 "funmap.pcc"
995 } break;
996 default: {
997 #line 498 "funmap.pcc"
998 return wild_term;
999 #line 498 "funmap.pcc"
1000 } break;
1001 }
1002 } break;
1003 case a_Pat::tag_TUPLEpat: {
1004 #line 503 "funmap.pcc"
1005 int arity = length (((Pat_TUPLEpat *)pat)->TUPLEpat);
1006 TreeTerm * subterms =
1007 (TreeTerm *)mem_pool.c_alloc(sizeof(TreeTerm) * arity);
1008 int i = 0;
1009 for_each (Pat, p, ((Pat_TUPLEpat *)pat)->TUPLEpat)
1010 { subterms[i++] = trans(p); }
1011 return new_term(mem_pool,0,arity,subterms);
1012
1013 #line 510 "funmap.pcc"
1014 } break;
1015 case a_Pat::tag_RECORDpat: {
1016 #line 512 "funmap.pcc"
1017
1018 #line 512 "funmap.pcc"
1019 #line 533 "funmap.pcc"
1020 {
1021 Ty _V3 = deref(pat->ty);
1022 if (_V3) {
1023 switch (_V3->tag__) {
1024 case a_Ty::tag_TYCONty: {
1025 if (boxed(((Ty_TYCONty *)_V3)->_1)) {
1026 switch (((Ty_TYCONty *)_V3)->_1->tag__) {
1027 case a_TyCon::tag_RECORDtycon: {
1028 #line 514 "funmap.pcc"
1029 Bool relevant[256]; int i; int arity;
1030 i = arity = 0;
1031 for_each(Ty, t, ((Ty_TYCONty *)_V3)->_2)
1032 { if (relevant[i++] = is_known_type(t)) arity++; }
1033 TreeTerm * subterms =
1034 (TreeTerm *)mem_pool.c_alloc(sizeof(TreeTerm) * arity);
1035 for (i = 0; i < arity; i++)
1036 subterms[i] = wild_term;
1037 for_each (LabPat, p, ((Pat_RECORDpat *)pat)->_1)
1038 { Ids labs; Tys ts;
1039 for (i = 0, labs = ((TyCon_RECORDtycon *)((Ty_TYCONty *)_V3)->_1)->_1, ts = ((Ty_TYCONty *)_V3)->_2;
1040 labs && ts; labs = labs->_2, ts = ts->_2)
1041 { if (p.label == labs->_1)
1042 { subterms[i] = trans(p.pat); break; }
1043 if (is_known_type(ts->_1)) i++;
1044 }
1045 }
1046 return new_term(mem_pool,0,arity,subterms);
1047
1048 #line 532 "funmap.pcc"
1049 } break;
1050 default: {
1051 L14:;
1052 #line 533 "funmap.pcc"
1053 bug("%Lillegal record pattern %p\n", pat);
1054 #line 533 "funmap.pcc"
1055 } break;
1056 }
1057 } else { goto L14; }
1058 } break;
1059 default: { goto L14; } break;
1060 }
1061 } else { goto L14; }
1062 }
1063 #line 534 "funmap.pcc"
1064 #line 534 "funmap.pcc"
1065
1066
1067 #line 535 "funmap.pcc"
1068 } break;
1069 case a_Pat::tag_LISTpat: {
1070 if (((Pat_LISTpat *)pat)->head) {
1071 #line 558 "funmap.pcc"
1072 Pat new_tail =
1073 #line 558 "funmap.pcc"
1074 #line 558 "funmap.pcc"
1075 LISTpat(((Pat_LISTpat *)pat)->cons, ((Pat_LISTpat *)pat)->nil, ((Pat_LISTpat *)pat)->head->_2, ((Pat_LISTpat *)pat)->tail)
1076 #line 558 "funmap.pcc"
1077 #line 558 "funmap.pcc"
1078 ;
1079 Pat new_p = APPpat(CONSpat(((Pat_LISTpat *)pat)->cons),TUPLEpat(
1080 #line 559 "funmap.pcc"
1081 #line 559 "funmap.pcc"
1082 list_1_(((Pat_LISTpat *)pat)->head->_1,list_1_(new_tail))
1083 #line 559 "funmap.pcc"
1084 #line 559 "funmap.pcc"
1085 ));
1086 new_p->ty = new_tail->ty = pat->ty;
1087 pat = new_p;
1088
1089 #line 562 "funmap.pcc"
1090 } else {
1091 if (((Pat_LISTpat *)pat)->tail) {
1092 #line 556 "funmap.pcc"
1093 pat = ((Pat_LISTpat *)pat)->tail;
1094 #line 556 "funmap.pcc"
1095 } else {
1096 #line 555 "funmap.pcc"
1097 Pat p = CONSpat(((Pat_LISTpat *)pat)->nil); p->ty = pat->ty; pat = p;
1098 #line 555 "funmap.pcc"
1099 }
1100 }
1101 } break;
1102 case a_Pat::tag_VECTORpat: {
1103 #line 564 "funmap.pcc"
1104 TreeTerm a = trans(TUPLEpat(((Pat_VECTORpat *)pat)->elements));
1105 int arity = length(((Pat_VECTORpat *)pat)->elements);
1106
1107 #line 566 "funmap.pcc"
1108 #line 572 "funmap.pcc"
1109 {
1110 if (a) {
1111 switch (a->tag__) {
1112 case a_TreeTerm::tag_tree_term: {
1113 #line 568 "funmap.pcc"
1114 ((TreeTerm_tree_term *)a)->_1 = vector_map[vector_id(((Pat_VECTORpat *)pat)->cons,pat->ty,arity)];
1115 return a;
1116
1117 #line 570 "funmap.pcc"
1118 } break;
1119 default: {
1120 L15:;
1121 #line 572 "funmap.pcc"
1122 bug ("%Lillegal pattern: %p\n", pat); return wild_term;
1123 #line 572 "funmap.pcc"
1124 } break;
1125 }
1126 } else { goto L15; }
1127 }
1128 #line 573 "funmap.pcc"
1129 #line 573 "funmap.pcc"
1130
1131
1132 #line 574 "funmap.pcc"
1133 } break;
1134 case a_Pat::tag_MARKEDpat: {
1135 #line 494 "funmap.pcc"
1136 pat = ((Pat_MARKEDpat *)pat)->_2;
1137 #line 494 "funmap.pcc"
1138 } break;
1139 default: { goto L12; } break;
1140 }
1141 } else { goto L11; }
1142 }
1143 }
1144 #line 576 "funmap.pcc"
1145 #line 576 "funmap.pcc"
1146
1147 }
1148
1149 ///////////////////////////////////////////////////////////////////////////////
1150 //
1151 // Compute ceil(ln(2))
1152 //
1153 ///////////////////////////////////////////////////////////////////////////////
1154 int ln2 (int n)
1155 { int bits = 0;
1156 while (n > 0) { n >>= 1; bits++; }
1157 return bits;
1158 }
1159
1160 ///////////////////////////////////////////////////////////////////////////////
1161 //
1162 // Method to compute the rhs non-terminal (if it is a chain rule)
1163 // Otherwise, returns NIL.
1164 //
1165 ///////////////////////////////////////////////////////////////////////////////
1166 Id FunctorMap::chain_rule_rhs (Pat pat)
1167 {
1168 #line 597 "funmap.pcc"
1169 #line 602 "funmap.pcc"
1170 {
1171 if (pat) {
1172 switch (pat->tag__) {
1173 case a_Pat::tag_IDpat: {
1174 #line 598 "funmap.pcc"
1175 return var_map.contains(((Pat_IDpat *)pat)->_1) ? ((Pat_IDpat *)pat)->_1 : 0;
1176 #line 598 "funmap.pcc"
1177 } break;
1178 case a_Pat::tag_TYPEDpat: {
1179 #line 601 "funmap.pcc"
1180 return chain_rule_rhs(((Pat_TYPEDpat *)pat)->_1);
1181 #line 601 "funmap.pcc"
1182 } break;
1183 case a_Pat::tag_ASpat: {
1184 #line 599 "funmap.pcc"
1185 return chain_rule_rhs(((Pat_ASpat *)pat)->_2);
1186 #line 599 "funmap.pcc"
1187 } break;
1188 case a_Pat::tag_MARKEDpat: {
1189 #line 600 "funmap.pcc"
1190 return chain_rule_rhs(((Pat_MARKEDpat *)pat)->_2);
1191 #line 600 "funmap.pcc"
1192 } break;
1193 default: {
1194 L16:;
1195 #line 602 "funmap.pcc"
1196 return 0;
1197 #line 602 "funmap.pcc"
1198 } break;
1199 }
1200 } else { goto L16; }
1201 }
1202 #line 603 "funmap.pcc"
1203 #line 603 "funmap.pcc"
1204
1205 }
1206
1207 ///////////////////////////////////////////////////////////////////////////////
1208 //
1209 // Method to partition the set of rules according to the types of the
1210 // patterns. Also encode the patterns in the process.
1211 //
1212 ///////////////////////////////////////////////////////////////////////////////
1213 MatchRules FunctorMap::partition_rules (MatchRules rules)
1214 { bottomup_rules =
1215 #line 613 "funmap.pcc"
1216 #line 613 "funmap.pcc"
1217 nil_1_
1218 #line 613 "funmap.pcc"
1219 #line 613 "funmap.pcc"
1220 ;
1221 // First, we assign a new type variable for each lhs non-terminal.
1222 { for_each (MatchRule, r, rules)
1223 {
1224 #line 616 "funmap.pcc"
1225 #line 634 "funmap.pcc"
1226 {
1227 #line 618 "funmap.pcc"
1228 if (r->mode == MatchRuleInfo::BOTTOMUP)
1229 { bottomup_rules =
1230 #line 619 "funmap.pcc"
1231 #line 619 "funmap.pcc"
1232 list_1_(r,bottomup_rules)
1233 #line 619 "funmap.pcc"
1234 #line 619 "funmap.pcc"
1235 ;
1236 if (r->_1)
1237 { HashTable::Entry * lhs_entry = nonterm_map.lookup(r->_1);
1238 if (! lhs_entry) nonterm_map.insert(r->_1,mkvar());
1239 encode(r->_1); // compute encoding for the variable
1240 HashTable::Entry * e = nonterm_rules.lookup(r->_1);
1241 if (! e) nonterm_rules.insert(r->_1,
1242 #line 625 "funmap.pcc"
1243 #line 625 "funmap.pcc"
1244 list_1_(r)
1245 #line 625 "funmap.pcc"
1246 #line 625 "funmap.pcc"
1247 );
1248 else { e->v =
1249 #line 626 "funmap.pcc"
1250 #line 626 "funmap.pcc"
1251 list_1_(r,MatchRules(e->v))
1252 #line 626 "funmap.pcc"
1253 #line 626 "funmap.pcc"
1254 ; }
1255 } else if (dynamic_search)
1256 error("%!missing non-terminal in tree grammar rule: %r\n",
1257 r->loc(), r);
1258 } else if (r->_1)
1259 { error("%!illegal non-terminal in non bottom-up rule: %r\n",
1260 r->loc(), r);
1261 }
1262
1263 #line 634 "funmap.pcc"
1264 }
1265 #line 635 "funmap.pcc"
1266 #line 635 "funmap.pcc"
1267
1268 }
1269 }
1270
1271 bottomup_rules = rev(bottomup_rules);
1272
1273 // Compute the size needed to encode each non-terminal
1274 { foreach_entry (e, nonterm_rules)
1275 { int bits = ln2(length(MatchRules(e->v))+1);
1276 nonterm_rules_bits.insert(e->k,HashTable::Value(bits));
1277 }
1278 }
1279
1280 // Type check all the rules next.
1281 // We have to also compute the type map for each lhs non-terminal.
1282 // Of course, a non-terminal but have only one single type.
1283 // This is done by unifying all occurances of a non-terminal.
1284
1285 patvar_typemap = &nonterm_map; // set the pattern variable type map
1286
1287 for_each (MatchRule, r, bottomup_rules)
1288 {
1289 #line 656 "funmap.pcc"
1290 #line 683 "funmap.pcc"
1291 {
1292 #line 658 "funmap.pcc"
1293 r->set_loc();
1294 Ty ty = r->ty = type_of(r->_2);
1295
1296 // Check the type of the non-terminal (if any).
1297 if (r->_1)
1298 { Ty lhs_ty = Ty(nonterm_map.lookup(r->_1)->v);
1299 if (! unify(lhs_ty, ty))
1300 { error("%!type mismatch between nonterminal %s(type %T) and rule %r(type %T)\n",
1301 r->loc(),r->_1,lhs_ty,r,ty);
1302 }
1303 }
1304
1305 if (! is_datatype(ty))
1306 error ("%!rule %r is of a non datatype: %T\n",r->loc(),r,ty);
1307
1308 // Collect chain rules.
1309 if (r->_1)
1310 { Id rhs = chain_rule_rhs(r->_2);
1311 if (rhs)
1312 { HashTable::Entry * cr = chain_rules.lookup(rhs);
1313 if (! cr) chain_rules.insert(rhs,
1314 #line 678 "funmap.pcc"
1315 #line 678 "funmap.pcc"
1316 list_1_(r)
1317 #line 678 "funmap.pcc"
1318 #line 678 "funmap.pcc"
1319 );
1320 else { cr->v =
1321 #line 679 "funmap.pcc"
1322 #line 679 "funmap.pcc"
1323 list_1_(r,MatchRules(cr->v))
1324 #line 679 "funmap.pcc"
1325 #line 679 "funmap.pcc"
1326 ; }
1327 r->is_chain_rule = true;
1328 }
1329 }
1330
1331 #line 683 "funmap.pcc"
1332 }
1333 #line 684 "funmap.pcc"
1334 #line 684 "funmap.pcc"
1335
1336 }
1337
1338 patvar_typemap = 0; // reset the pattern variable type map
1339
1340 // Now partition rules by type and assign functor encoding.
1341 // Since we have also typed the rules, this is quite simple: just
1342 // another pass. We have to make sure that after the type inference
1343 // we don't have any more polymorphic types inside the patterns.
1344 int rule_num = 0;
1345 for_each (MatchRule, R, rules)
1346 {
1347 #line 695 "funmap.pcc"
1348 #line 720 "funmap.pcc"
1349 {
1350 if (
1351 #line 696 "funmap.pcc"
1352 (R->mode != MatchRuleInfo::BOTTOMUP)
1353 #line 696 "funmap.pcc"
1354 ) {
1355
1356 #line 697 "funmap.pcc"
1357 R->set_loc();
1358 R->ty = type_of(R->_2);
1359 HashTable::Entry * e = rule_maps[R->mode]->lookup(R->ty);
1360 if (e) e->v =
1361 #line 700 "funmap.pcc"
1362 #line 700 "funmap.pcc"
1363 list_1_(R,MatchRules(e->v))
1364 #line 700 "funmap.pcc"
1365 #line 700 "funmap.pcc"
1366 ;
1367 else rule_maps[R->mode]->insert(R->ty,
1368 #line 701 "funmap.pcc"
1369 #line 701 "funmap.pcc"
1370 list_1_(R)
1371 #line 701 "funmap.pcc"
1372 #line 701 "funmap.pcc"
1373 );
1374
1375 #line 702 "funmap.pcc"
1376 } else {
1377
1378 #line 704 "funmap.pcc"
1379 if (! is_ground(R->ty))
1380 error ("%!rule %r has incomplete type %T\n",R->loc(),R,R->ty);
1381
1382 HashTable::Entry * e = rule_map.lookup(R->ty);
1383 if (e) e->v =
1384 #line 708 "funmap.pcc"
1385 #line 708 "funmap.pcc"
1386 list_1_(R,MatchRules(e->v))
1387 #line 708 "funmap.pcc"
1388 #line 708 "funmap.pcc"
1389 ;
1390 else rule_map.insert(R->ty,
1391 #line 709 "funmap.pcc"
1392 #line 709 "funmap.pcc"
1393 list_1_(R)
1394 #line 709 "funmap.pcc"
1395 #line 709 "funmap.pcc"
1396 );
1397
1398 // convert literals into guards
1399 // BUG: 2-6-97 This doesn't work right since
1400 // the guard testing is not prioritized properly !!!
1401 R->_2 = make_guard (R->_2, R->_3);
1402
1403 // assign functor encoding
1404 encode(R->_2);
1405
1406 R->rule_number = rule_num++;
1407
1408 #line 720 "funmap.pcc"
1409 }
1410 }
1411 #line 721 "funmap.pcc"
1412 #line 721 "funmap.pcc"
1413
1414 }
1415
1416 return bottomup_rules;
1417 }
1418
1419 ///////////////////////////////////////////////////////////////////////////////
1420 //
1421 // Method to compute the functor and variable table.
1422 //
1423 ///////////////////////////////////////////////////////////////////////////////
1424 void FunctorMap::compute_names ()
1425 {
1426 functor_names = (Id *)mem_pool.c_alloc(sizeof(Id) * functors);
1427 variable_names = (Id *)mem_pool.c_alloc(sizeof(Id) * (variables + N + 4));
1428
1429 { for (int i = N + variables - 1; i >= 0; i--) variable_names[i] = 0; }
1430 { for (int i = functors - 1; i >= 0; i--) functor_names[i] = "???"; }
1431 variable_names[0] = "_";
1432
1433 // Compute variable names
1434 { foreach_entry (i,var_map)
1435 variable_names[var_map.value(i)] = (Id)var_map.key(i);
1436 }
1437
1438 // Compute literal names
1439 { foreach_entry (i,literal_map)
1440 { Literal l = (Literal)literal_map.key(i);
1441 Functor f = literal_map.value(i);
1442 char buf[1024];
1443 std::ostrstream b(buf,sizeof(buf));
1444 std::ostream& s = b;
1445 s << l << std::ends;
1446 functor_names[f] = Quark(buf);
1447 }
1448 }
1449
1450 // Compute constructor names
1451 { foreach_entry (i,type_map)
1452 { Ty t = (Ty)type_map.key(i);
1453 Functor f = type_map.value(i);
1454
1455 #line 762 "funmap.pcc"
1456 #line 775 "funmap.pcc"
1457 {
1458 Ty _V5 = deref(t);
1459 if (_V5) {
1460 switch (_V5->tag__) {
1461 case a_Ty::tag_TYCONty: {
1462 if (boxed(((Ty_TYCONty *)_V5)->_1)) {
1463 switch (((Ty_TYCONty *)_V5)->_1->tag__) {
1464 case a_TyCon::tag_DATATYPEtycon: {
1465 #line 764 "funmap.pcc"
1466 int arity = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V5)->_1)->unit + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V5)->_1)->arg;
1467 for (int j = 0; j < arity; j++)
1468 {
1469 #line 766 "funmap.pcc"
1470 #line 772 "funmap.pcc"
1471 {
1472 Cons _V6 = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V5)->_1)->terms[j];
1473 if (_V6) {
1474 #line 768 "funmap.pcc"
1475 functor_names[f + (_V6->ty == NOty ? _V6->tag : _V6->tag + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V5)->_1)->unit)] =
1476 _V6->name;
1477
1478 #line 770 "funmap.pcc"
1479 } else {}
1480 }
1481 #line 772 "funmap.pcc"
1482 #line 772 "funmap.pcc"
1483
1484 }
1485
1486 #line 774 "funmap.pcc"
1487 } break;
1488 default: {
1489 L17:;
1490 #line 775 "funmap.pcc"
1491 bug ("compute_names()");
1492 #line 775 "funmap.pcc"
1493 } break;
1494 }
1495 } else { goto L17; }
1496 } break;
1497 default: { goto L17; } break;
1498 }
1499 } else { goto L17; }
1500 }
1501 #line 776 "funmap.pcc"
1502 #line 776 "funmap.pcc"
1503
1504 }
1505 }
1506
1507 // Compute vector constructor names
1508 { foreach_entry (i, vector_map)
1509 { VectorId id = (VectorId)vector_map.key(i);
1510 Functor f = vector_map.value(i);
1511 if (id->cons) functor_names[f] = id->cons->name;
1512 }
1513 }
1514 }
1515
1516 ///////////////////////////////////////////////////////////////////////////////
1517 //
1518 // Method to print a report detailing the functor/variable encoding,
1519 // the tree grammar and the generated table size.
1520 //
1521 ///////////////////////////////////////////////////////////////////////////////
1522 void FunctorMap::print_report (std::ostream& log)
1523 {
1524 if (var_map.size() > 0)
1525 { log << "Variable encoding:\n";
1526 foreach_entry (e, var_map)
1527 { log << "\tnon-terminal \"" << (Id)var_map.key(e) << "\"\t=\t"
1528 << var_map.value(e) << '\n';
1529 }
1530 }
1531
1532 if (literal_map.size() > 0)
1533 { log << "\nFunctor encoding for literals:\n";
1534 foreach_entry (e, literal_map)
1535 { log << "literal " << (Literal)literal_map.key(e) << "\t=\t"
1536 << literal_map.value(e) << '\n';
1537 }
1538 }
1539
1540 log << "\nFunctor encoding for constructors:\n";
1541
1542 { foreach_entry (e, type_map)
1543 { Ty t = (Ty)type_map.key(e);
1544 Functor f = type_map.value(e);
1545 log << "datatype " << t << ":\n";
1546
1547 #line 819 "funmap.pcc"
1548 #line 833 "funmap.pcc"
1549 {
1550 Ty _V7 = deref(t);
1551 if (_V7) {
1552 switch (_V7->tag__) {
1553 case a_Ty::tag_TYCONty: {
1554 if (boxed(((Ty_TYCONty *)_V7)->_1)) {
1555 switch (((Ty_TYCONty *)_V7)->_1->tag__) {
1556 case a_TyCon::tag_DATATYPEtycon: {
1557 #line 821 "funmap.pcc"
1558 int arity = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V7)->_1)->unit + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V7)->_1)->arg;
1559 for (int i = 0; i < arity; i++)
1560 {
1561 #line 823 "funmap.pcc"
1562 #line 829 "funmap.pcc"
1563 {
1564 Cons _V8 = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V7)->_1)->terms[i];
1565 if (_V8) {
1566 #line 825 "funmap.pcc"
1567 log << '\t' << _V8->name << "\t=\t"
1568 << f + (_V8->ty == NOty ? _V8->tag : _V8->tag + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V7)->_1)->unit) << '\n';
1569
1570 #line 827 "funmap.pcc"
1571 } else {}
1572 }
1573 #line 829 "funmap.pcc"
1574 #line 829 "funmap.pcc"
1575
1576 }
1577
1578 #line 831 "funmap.pcc"
1579 } break;
1580 default: {
1581 L18:; } break;
1582 }
1583 } else { goto L18; }
1584 } break;
1585 default: { goto L18; } break;
1586 }
1587 } else { goto L18; }
1588 }
1589 #line 833 "funmap.pcc"
1590 #line 833 "funmap.pcc"
1591
1592 }
1593 }
1594
1595 if (tree_gen)
1596 {
1597 log << "\nIndex compression is "
1598 << (use_compression ? "enabled" : "disabled")
1599 << "\nAlgorithm is " << tree_gen->algorithm();
1600 tree_gen->print_report(log);
1601 }
1602 }
1603
1604 ///////////////////////////////////////////////////////////////////////////////
1605 //
1606 // Method to return the cost expression for a pattern.
1607 //
1608 ///////////////////////////////////////////////////////////////////////////////
1609 Exp FunctorMap::cost_expr (Id lhs, Pat pat)
1610 {
1611 #line 852 "funmap.pcc"
1612 #line 854 "funmap.pcc"
1613 {
1614 if (pat) {
1615 #line 854 "funmap.pcc"
1616 return cost_expr(lhs,pat,LITERALexp(INTlit(1)));
1617 #line 854 "funmap.pcc"
1618 } else {
1619 #line 853 "funmap.pcc"
1620 return LITERALexp(INTlit(0));
1621 #line 853 "funmap.pcc"
1622 }
1623 }
1624 #line 855 "funmap.pcc"
1625 #line 855 "funmap.pcc"
1626
1627 }
1628
1629 ///////////////////////////////////////////////////////////////////////////////
1630 //
1631 // Method to compute the cost expression for a pattern
1632 //
1633 ///////////////////////////////////////////////////////////////////////////////
1634 Exp FunctorMap::cost_expr (Id lhs, Pat pat, Exp exp)
1635 {
1636 #line 864 "funmap.pcc"
1637 #line 883 "funmap.pcc"
1638 {
1639 if (pat) {
1640 switch (pat->tag__) {
1641 case a_Pat::tag_WILDpat: {} break;
1642 case a_Pat::tag_IDpat: {} break;
1643 case a_Pat::tag_APPpat: {
1644 #line 870 "funmap.pcc"
1645 return cost_expr(lhs,((Pat_APPpat *)pat)->_2,exp);
1646 #line 870 "funmap.pcc"
1647 } break;
1648 case a_Pat::tag_TYPEDpat: {
1649 #line 868 "funmap.pcc"
1650 return cost_expr(lhs,((Pat_TYPEDpat *)pat)->_1,exp);
1651 #line 868 "funmap.pcc"
1652 } break;
1653 case a_Pat::tag_ASpat: {
1654 #line 866 "funmap.pcc"
1655 return cost_expr(lhs,((Pat_ASpat *)pat)->_2,exp);
1656 #line 866 "funmap.pcc"
1657 } break;
1658 case a_Pat::tag_CONTEXTpat: {
1659 #line 871 "funmap.pcc"
1660 return cost_expr(lhs,((Pat_CONTEXTpat *)pat)->_2,exp);
1661 #line 871 "funmap.pcc"
1662 } break;
1663 case a_Pat::tag_ARRAYpat: {
1664 #line 874 "funmap.pcc"
1665 return cost_expr(lhs,((Pat_ARRAYpat *)pat)->_1,exp);
1666 #line 874 "funmap.pcc"
1667 } break;
1668 case a_Pat::tag_TUPLEpat: {
1669 #line 872 "funmap.pcc"
1670 return cost_expr(lhs,((Pat_TUPLEpat *)pat)->TUPLEpat,exp);
1671 #line 872 "funmap.pcc"
1672 } break;
1673 case a_Pat::tag_EXTUPLEpat: {
1674 #line 873 "funmap.pcc"
1675 return cost_expr(lhs,((Pat_EXTUPLEpat *)pat)->EXTUPLEpat,exp);
1676 #line 873 "funmap.pcc"
1677 } break;
1678 case a_Pat::tag_RECORDpat: {
1679 #line 875 "funmap.pcc"
1680 return cost_expr(lhs,((Pat_RECORDpat *)pat)->_1,exp);
1681 #line 875 "funmap.pcc"
1682 } break;
1683 case a_Pat::tag_LISTpat: {
1684 #line 877 "funmap.pcc"
1685 return cost_expr(lhs,((Pat_LISTpat *)pat)->head,cost_expr(lhs,((Pat_LISTpat *)pat)->tail,exp));
1686 #line 877 "funmap.pcc"
1687 } break;
1688 case a_Pat::tag_VECTORpat: {
1689 #line 879 "funmap.pcc"
1690 return cost_expr(lhs,((Pat_VECTORpat *)pat)->len,cost_expr(lhs,((Pat_VECTORpat *)pat)->array,
1691 cost_expr(lhs,((Pat_VECTORpat *)pat)->elements,exp)));
1692 #line 880 "funmap.pcc"
1693 } break;
1694 case a_Pat::tag_GUARDpat: {
1695 #line 869 "funmap.pcc"
1696 return cost_expr(lhs,((Pat_GUARDpat *)pat)->_1,exp);
1697 #line 869 "funmap.pcc"
1698 } break;
1699 case a_Pat::tag_MARKEDpat: {
1700 #line 867 "funmap.pcc"
1701 return cost_expr(lhs,((Pat_MARKEDpat *)pat)->_2,exp);
1702 #line 867 "funmap.pcc"
1703 } break;
1704 case a_Pat::tag_CONSpat:
1705 case a_Pat::tag_LITERALpat: {
1706 L19:;
1707 #line 865 "funmap.pcc"
1708 return exp;
1709 #line 865 "funmap.pcc"
1710 } break;
1711 default: {
1712 #line 883 "funmap.pcc"
1713 return exp;
1714 #line 883 "funmap.pcc"
1715 } break;
1716 }
1717 } else { goto L19; }
1718 }
1719 #line 884 "funmap.pcc"
1720 #line 884 "funmap.pcc"
1721
1722
1723 // BUG fix: if the argument type is not a datatype or
1724 // not rewritable, then there is no cost to consider.
1725 if (! is_datatype(pat->ty) || ! is_rewritable_type(pat->ty))
1726 return exp;
1727
1728 Ty state_rec_ty = mkptrty(mkidty(Quark(class_name,"_StateRec"),
1729 #line 891 "funmap.pcc"
1730 #line 891 "funmap.pcc"
1731 nil_1_
1732 #line 891 "funmap.pcc"
1733 #line 891 "funmap.pcc"
1734 ));
1735 Exp cost_e =
1736 INDEXexp(
1737 ARROWexp(
1738 CASTexp(state_rec_ty,
1739 APPexp(ARROWexp(pat->selector,"get_state_rec"), TUPLEexp(
1740 #line 896 "funmap.pcc"
1741 #line 896 "funmap.pcc"
1742 nil_1_
1743 #line 896 "funmap.pcc"
1744 #line 896 "funmap.pcc"
1745 ))),
1746 "cost"), LITERALexp(INTlit(int(var_map[lhs]))));
1747 return exp == NOexp ? cost_e : BINOPexp("+",cost_e,exp);
1748 }
1749
1750 ///////////////////////////////////////////////////////////////////////////////
1751 //
1752 // Method to compute the cost expression for a pattern list
1753 //
1754 ///////////////////////////////////////////////////////////////////////////////
1755 Exp FunctorMap::cost_expr (Id lhs, Pats pats, Exp exp)
1756 {
1757 #line 907 "funmap.pcc"
1758 #line 909 "funmap.pcc"
1759 {
1760 if (pats) {
1761 #line 909 "funmap.pcc"
1762 return cost_expr(lhs,pats->_1,cost_expr(lhs,pats->_2,exp));
1763 #line 909 "funmap.pcc"
1764 } else {
1765 #line 908 "funmap.pcc"
1766 return exp;
1767 #line 908 "funmap.pcc"
1768 }
1769 }
1770 #line 910 "funmap.pcc"
1771 #line 910 "funmap.pcc"
1772
1773 }
1774
1775 ///////////////////////////////////////////////////////////////////////////////
1776 //
1777 // Method to compute the cost expression for a labeled pattern list
1778 //
1779 ///////////////////////////////////////////////////////////////////////////////
1780 Exp FunctorMap::cost_expr (Id lhs, LabPats pats, Exp exp)
1781 {
1782 #line 919 "funmap.pcc"
1783 #line 921 "funmap.pcc"
1784 {
1785 if (pats) {
1786 #line 921 "funmap.pcc"
1787 return cost_expr(lhs,pats->_1.pat,cost_expr(lhs,pats->_2,exp));
1788 #line 921 "funmap.pcc"
1789 } else {
1790 #line 920 "funmap.pcc"
1791 return exp;
1792 #line 920 "funmap.pcc"
1793 }
1794 }
1795 #line 922 "funmap.pcc"
1796 #line 922 "funmap.pcc"
1797
1798 }
1799
1800 #line 925 "funmap.pcc"
1801 /*
1802 ------------------------------- Statistics -------------------------------
1803 Merge matching rules = yes
1804 Number of DFA nodes merged = 352
1805 Number of ifs generated = 37
1806 Number of switches generated = 25
1807 Number of labels = 15
1808 Number of gotos = 34
1809 Adaptive matching = enabled
1810 Fast string matching = disabled
1811 Inline downcasts = enabled
1812 --------------------------------------------------------------------------
1813 */
Prop: a C++ based pattern matching language