prop-src/matchgen.cc

   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 "matchgen.pcc".
   5 ///////////////////////////////////////////////////////////////////////////////
   6
   7 #line 1 "matchgen.pcc"
   8 ///////////////////////////////////////////////////////////////////////////////
   9 //
  10 //  This file implements the backend for pattern matching,
  11 //  string matching, and lexical scanning constructs.  C++ code is
  12 //  emitted in this file.
  13 //
  14 ///////////////////////////////////////////////////////////////////////////////
  15
  16 #include <limits.h>
  17 #include <iostream>
  18 #include <strstream>
  19 #include <AD/contain/bitset.h>
  20 #include <AD/automata/lexergen.h>
  21 #include <AD/strings/charesc.h>
  22 #include <AD/memory/mempool.h>
  23 #include <AD/sort/heapsort.h>
  24 #include <AD/sort/heapsrt2.h>
  25 #include "ir.h"
  26 #include "ast.h"
  27 #include "matchcom.h"
  28 #include "type.h"
  29 #include "labelgen.h"
  30 #include "hashtab.h"
  31 #include "config.h"
  32 #include "options.h"
  33 #include "list.h"
  34
  35 ///////////////////////////////////////////////////////////////////////////////
  36 //
  37 //  Class to mark the current rule.
  38 //
  39 ///////////////////////////////////////////////////////////////////////////////
  40 MarkCurrentRule::MarkCurrentRule(MatchRule& c, MatchRule n)
  41    : current_rule(c), old_rule(c) { c = n; }
  42 MarkCurrentRule::~MarkCurrentRule() { current_rule = old_rule; }
  43
  44 ///////////////////////////////////////////////////////////////////////////////
  45 //
  46 //  Method to extract the line number of the current rule
  47 //
  48 ///////////////////////////////////////////////////////////////////////////////
  49 int MatchCompiler::current_rule_line() const
  50 {  if (current_rule == 0) bug("MatchCompiler::current_rule_line()\n");
  51    return current_rule->begin_line;
  52 }
  53
  54 ///////////////////////////////////////////////////////////////////////////////
  55 //
  56 //  Method to extract the text of the current rule
  57 //
  58 ///////////////////////////////////////////////////////////////////////////////
  59 const char * MatchCompiler::current_rule_text() const
  60 {  if (current_rule == 0) bug("MatchCompiler::current_rule_text()\n");
  61    char buffer[4096];
  62    std::ostrstream stream(buffer,sizeof(buffer));
  63    std::ostream& s = stream;
  64    s << current_rule << std::ends;
  65    buffer[sizeof(buffer)-1] = '\0';
  66    return make_quoted_string(buffer);
  67 }
  68
  69 ///////////////////////////////////////////////////////////////////////////////
  70 //
  71 //  Current index map.
  72 //
  73 ///////////////////////////////////////////////////////////////////////////////
  74 HashTable * current_index_map = 0;
  75 Bool        merge_match       = true;  // should we merge the DFAs?
  76 Id          current_failure   = 0;     // jump label for failure
  77
  78 ///////////////////////////////////////////////////////////////////////////////
  79 //
  80 //  Is the expression simple?
  81 //
  82 ///////////////////////////////////////////////////////////////////////////////
  83 Bool is_simple_exp (Exp exp)
  84 {
  85 #line 77 "matchgen.pcc"
  86 #line 80 "matchgen.pcc"
  87 {
  88    for (;;) {
  89       if (exp) {
  90          switch (exp->tag__) {
  91             case a_Exp::tag_MARKEDexp: {
  92 #line 79 "matchgen.pcc"
  93               exp = ((Exp_MARKEDexp *)exp)->_2;
  94 #line 79 "matchgen.pcc"
  95                } break;
  96             case a_Exp::tag_LITERALexp:
  97             case a_Exp::tag_IDexp: {
  98 #line 78 "matchgen.pcc"
  99               return true;
 100 #line 78 "matchgen.pcc"
 101                } break;
 102             default: {
 103                L2:;
 104 #line 80 "matchgen.pcc"
 105               return false;
 106 #line 80 "matchgen.pcc"
 107                } break;
 108          }
 109       } else { goto L2; }
 110    }
 111 }
 112 #line 81 "matchgen.pcc"
 113 #line 81 "matchgen.pcc"
 114
 115 }
 116
 117
 118 ///////////////////////////////////////////////////////////////////////////////
 119 //
 120 //  Generate match variable bindings for complex match expressions.
 121 //
 122 ///////////////////////////////////////////////////////////////////////////////
 123 void compute_match_variables(MatchExps exps)
 124 {  static LabelGen vars("_V");
 125    for_each (MatchExp, me, exps)
 126    {
 127 #line 93 "matchgen.pcc"
 128 #line 96 "matchgen.pcc"
 129 {
 130    if (
 131 #line 94 "matchgen.pcc"
 132    ((me->_2 == 0) && (! is_simple_exp(me->_1)))
 133 #line 94 "matchgen.pcc"
 134 ) {
 135
 136 #line 95 "matchgen.pcc"
 137     me->_2 = vars.new_label();
 138 #line 95 "matchgen.pcc"
 139    } else {
 140
 141 #line 96 "matchgen.pcc"
 142      /* skip */
 143 #line 96 "matchgen.pcc"
 144    }
 145 }
 146 #line 97 "matchgen.pcc"
 147 #line 97 "matchgen.pcc"
 148
 149    }
 150 }
 151
 152 ///////////////////////////////////////////////////////////////////////////////
 153 //
 154 //  Generate pattern matching code from a match dag
 155 //
 156 ///////////////////////////////////////////////////////////////////////////////
 157 void MatchCompiler::gen(Match mt, MatchOptions match_options, Ty match_ty)
 158 {
 159    if (mt == FAILmatch) {
 160       if (current_failure) pr ("%? goto %s; ", current_failure);
 161       return;
 162    }
 163
 164    // check for duplicates
 165    if (mt->label)      { pr ("%? goto %s; ", mt->label); gotos++; return; }
 166    if (mt->shared > 1) { goto_labels++;
 167                         pr ("%^%s:; ", mt->label = labels.new_label()); }
 168
 169 #line 117 "matchgen.pcc"
 170 #line 190 "matchgen.pcc"
 171 {
 172    if (boxed(mt)) {
 173       switch (mt->tag__) {
 174          case a_Match::tag_SUCCESSmatch: {
 175 #line 120 "matchgen.pcc"
 176            MarkCurrentRule mark(current_rule,((Match_SUCCESSmatch *)mt)->_2); pr ("%&", ((Match_SUCCESSmatch *)mt)->_2->_5);
 177 #line 120 "matchgen.pcc"
 178             } break;
 179          case a_Match::tag_SUCCESSESmatch: {
 180 #line 125 "matchgen.pcc"
 181            if (current_options & MATCHwithtreecost)
 182             gen_treecost_match(FAILmatch,((Match_SUCCESSESmatch *)mt)->_2,((Match_SUCCESSESmatch *)mt)->_3);
 183             else
 184             gen_success_match(((Match_SUCCESSESmatch *)mt)->_1,((Match_SUCCESSESmatch *)mt)->_2,((Match_SUCCESSESmatch *)mt)->_3);
 185
 186 #line 129 "matchgen.pcc"
 187             } break;
 188          case a_Match::tag_COSTmatch: {
 189 #line 121 "matchgen.pcc"
 190            gen_cost_success_match(((Match_COSTmatch *)mt)->_1,((Match_COSTmatch *)mt)->_3,((Match_COSTmatch *)mt)->_4);
 191 #line 121 "matchgen.pcc"
 192             } break;
 193          case a_Match::tag_GUARDmatch: {
 194 #line 132 "matchgen.pcc"
 195           ifs++; pr ("%^if (%E) {%+%^%m%-%?} else {%+%^%m%-%?}\n",((Match_GUARDmatch *)mt)->_1,((Match_GUARDmatch *)mt)->_2,((Match_GUARDmatch *)mt)->_3);
 196 #line 132 "matchgen.pcc"
 197             } break;
 198          case a_Match::tag_LITERALmatch: {
 199             switch (((Match_LITERALmatch *)mt)->_3[0]->tag__) {
 200                case a_Literal::tag_REGEXPlit: {
 201 #line 185 "matchgen.pcc"
 202                  if (options.generate_report) open_logfile() << mt << '\n';
 203                   gen_regexp_match(((Match_LITERALmatch *)mt)->_2,((Match_LITERALmatch *)mt)->_4,((Match_LITERALmatch *)mt)->_3,((Match_LITERALmatch *)mt)->_5,((Match_LITERALmatch *)mt)->_6,match_options,match_ty);
 204
 205 #line 187 "matchgen.pcc"
 206                   } break;
 207                case a_Literal::tag_QUARKlit: {
 208 #line 189 "matchgen.pcc"
 209                  gen_quark_match(((Match_LITERALmatch *)mt)->_2,((Match_LITERALmatch *)mt)->_4,((Match_LITERALmatch *)mt)->_3,((Match_LITERALmatch *)mt)->_5,((Match_LITERALmatch *)mt)->_6,match_options);
 210 #line 189 "matchgen.pcc"
 211                   } break;
 212                case a_Literal::tag_BIGINTlit: {
 213                   L3:;
 214 #line 190 "matchgen.pcc"
 215                  bug ("gen(Match)");
 216 #line 190 "matchgen.pcc"
 217                   } break;
 218                case a_Literal::tag_REALlit:
 219                case a_Literal::tag_STRINGlit: {
 220 #line 183 "matchgen.pcc"
 221                  gen_binary_search_on_literals(((Match_LITERALmatch *)mt)->_2,((Match_LITERALmatch *)mt)->_4,((Match_LITERALmatch *)mt)->_3,((Match_LITERALmatch *)mt)->_5,((Match_LITERALmatch *)mt)->_6);
 222 #line 183 "matchgen.pcc"
 223                   } break;
 224                default: {
 225 #line 158 "matchgen.pcc"
 226                 Bool is_boolean;
 227
 228 #line 159 "matchgen.pcc"
 229 #line 161 "matchgen.pcc"
 230                   {
 231                      Literal _V1 = ((Match_LITERALmatch *)mt)->_3[0];
 232                      switch (_V1->tag__) {
 233                         case a_Literal::tag_BOOLlit: {
 234 #line 160 "matchgen.pcc"
 235                           is_boolean = true;
 236 #line 160 "matchgen.pcc"
 237                            } break;
 238                         default: {
 239 #line 161 "matchgen.pcc"
 240                           is_boolean = false;
 241 #line 161 "matchgen.pcc"
 242                            } break;
 243                      }
 244                   }
 245 #line 162 "matchgen.pcc"
 246 #line 162 "matchgen.pcc"
 247
 248                   switches++;
 249                   pr ("%^switch (%e) {\n%+", ((Match_LITERALmatch *)mt)->_2);
 250                   for (int i = 0; i < ((Match_LITERALmatch *)mt)->_4; ) {
 251                      int j;
 252                      for (j = i+1; j < ((Match_LITERALmatch *)mt)->_4; j++) if (((Match_LITERALmatch *)mt)->_5[i] != ((Match_LITERALmatch *)mt)->_5[j]) break;
 253                      int k = i;
 254                      if (is_boolean && j == ((Match_LITERALmatch *)mt)->_4 && ((Match_LITERALmatch *)mt)->_4 == 2) {
 255                         pr ("%^default:"); i = ((Match_LITERALmatch *)mt)->_4;
 256                      } else {
 257                         for ( ; i < j; i++) {
 258                            pr ("%^case %l:", ((Match_LITERALmatch *)mt)->_3[i]);
 259                            if (i != j - 1) pr ("\n");
 260                         }
 261                      }
 262                      pr(" {%+%m%-%?} break;\n", ((Match_LITERALmatch *)mt)->_5[k]);
 263                   }
 264                   if (! is_boolean || ((Match_LITERALmatch *)mt)->_4 < 2) pr ("%^default: {%+%m%-%?}", ((Match_LITERALmatch *)mt)->_6);
 265                   pr("%-%^}\n");
 266
 267 #line 181 "matchgen.pcc"
 268                   } break;
 269             }
 270             } break;
 271          case a_Match::tag_RANGEmatch: {
 272 #line 130 "matchgen.pcc"
 273            gen_range_match(((Match_RANGEmatch *)mt)->_1,((Match_RANGEmatch *)mt)->_2,((Match_RANGEmatch *)mt)->_3,((Match_RANGEmatch *)mt)->_4,((Match_RANGEmatch *)mt)->_5,((Match_RANGEmatch *)mt)->_6,mt);
 274 #line 130 "matchgen.pcc"
 275             } break;
 276          case a_Match::tag_CONSmatch: {
 277             if (((Match_CONSmatch *)mt)->_4) {
 278                switch (((Match_CONSmatch *)mt)->_4->tag__) {
 279                   case a_Ty::tag_TYCONty: {
 280                      if (boxed(((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)) {
 281                         switch (((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1->tag__) {
 282                            case a_TyCon::tag_DATATYPEtycon: {
 283                               if (
 284 #line 135 "matchgen.pcc"
 285                               (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALview)
 286 #line 135 "matchgen.pcc"
 287 ) {
 288
 289 #line 136 "matchgen.pcc"
 290                                 gen_view_match (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->id, ((Match_CONSmatch *)mt)->_2, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->view_match, ((Match_CONSmatch *)mt)->_5, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->terms, ((Match_CONSmatch *)mt)->_6, ((Match_CONSmatch *)mt)->_7,
 291                                  ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->opt, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALextensible);
 292 #line 137 "matchgen.pcc"
 293                               } else {
 294
 295                                  switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->arg) {
 296                                     case 0: {
 297 #line 140 "matchgen.pcc"
 298                                       gen_switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->id, ((Match_CONSmatch *)mt)->_2, ((Match_CONSmatch *)mt)->_3, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->terms, ((Match_CONSmatch *)mt)->_6, ((Match_CONSmatch *)mt)->_7, mt->shared,
 299                                        false, false, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->opt, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALextensible);
 300 #line 141 "matchgen.pcc"
 301                                     } break;
 302                                     default: {
 303                                        switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit) {
 304                                           case 0: {
 305 #line 144 "matchgen.pcc"
 306                                             gen_switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->id, ((Match_CONSmatch *)mt)->_2, ((Match_CONSmatch *)mt)->_3, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->arg, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->terms, ((Match_CONSmatch *)mt)->_6, ((Match_CONSmatch *)mt)->_7, mt->shared,
 307                                              false, true, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->opt, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALextensible);
 308 #line 145 "matchgen.pcc"
 309                                           } break;
 310                                           default: {
 311 #line 148 "matchgen.pcc"
 312                                            ifs++;
 313                                              pr ((((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit > 1 ? "%^if (boxed(%e)) {%+" : "%^if (%e) {%+"), ((Match_CONSmatch *)mt)->_2);
 314                                              gen_switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->id, ((Match_CONSmatch *)mt)->_2, ((Match_CONSmatch *)mt)->_3, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->arg, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->terms + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit, ((Match_CONSmatch *)mt)->_6 + ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit, ((Match_CONSmatch *)mt)->_7, mt->shared,
 315                                                          true, true, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->opt, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALextensible);
 316                                              pr ("%-%?} else {%+");
 317                                              gen_switch (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->id, ((Match_CONSmatch *)mt)->_2, ((Match_CONSmatch *)mt)->_3, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->unit, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->terms, ((Match_CONSmatch *)mt)->_6, ((Match_CONSmatch *)mt)->_7, mt->shared,
 318                                                          true, false, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->opt, ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)((Match_CONSmatch *)mt)->_4)->_1)->qualifiers & QUALextensible);
 319                                              pr ("%-%?}\n");
 320
 321 #line 156 "matchgen.pcc"
 322                                           }
 323                                        }
 324                                     }
 325                                  }
 326                               }
 327                               } break;
 328                            default: { goto L3; } break;
 329                         }
 330                      } else { goto L3; }
 331                      } break;
 332                   default: { goto L3; } break;
 333                }
 334             } else { goto L3; }
 335             } break;
 336          case a_Match::tag_TREECOSTmatch: {
 337 #line 122 "matchgen.pcc"
 338            gen_treecost_match(((Match_TREECOSTmatch *)mt)->_1,((Match_TREECOSTmatch *)mt)->_2,((Match_TREECOSTmatch *)mt)->_3);
 339 #line 122 "matchgen.pcc"
 340             } break;
 341          case a_Match::tag_TREELABELmatch: {
 342 #line 123 "matchgen.pcc"
 343            gen_treelabel_match(((Match_TREELABELmatch *)mt)->_1,((Match_TREELABELmatch *)mt)->_2,((Match_TREELABELmatch *)mt)->_3,((Match_TREELABELmatch *)mt)->_4);
 344 #line 123 "matchgen.pcc"
 345             } break;
 346          default: { goto L3; } break;
 347       }
 348    } else {
 349       if (mt) {
 350           goto L3; } else {
 351          }
 352    }
 353 }
 354 #line 191 "matchgen.pcc"
 355 #line 191 "matchgen.pcc"
 356
 357 }
 358
 359 ///////////////////////////////////////////////////////////////////////////////
 360 //
 361 //  Method to generate a bitmap of all the successful matching rules.
 362 //
 363 ///////////////////////////////////////////////////////////////////////////////
 364 void MatchCompiler::gen_success_match(int n, const BitSet * set, MatchRules)
 365 {  pr ("%^{%+  static const unsigned char matched_set__[%i] =\n%^{  %+",
 366        (n + 7) / 8
 367       );
 368    for(int i = 0; i < (n + 7) / 8; i++) {
 369       if (i > 0) pr (", ");
 370       if (i != 0 && (i % 8) == 0) pr ("%^");
 371       pr ("%i ", (int)set->byte(i));
 372    }
 373    pr ("%-};\n"
 374        "%^m__ = matched_set__;\n"
 375        "%-%^}\n"
 376       );
 377 }
 378
 379 ///////////////////////////////////////////////////////////////////////////////
 380 //
 381 //  Method to generate code for cost minimalization.
 382 //
 383 ///////////////////////////////////////////////////////////////////////////////
 384 void MatchCompiler::gen_cost_success_match(int n, const BitSet * set,
 385                                            MatchRules rules)
 386 {  int rule_no = 0;
 387
 388 #line 222 "matchgen.pcc"
 389 #line 237 "matchgen.pcc"
 390 {
 391    for (;;) {
 392       if (rules) {
 393 #line 224 "matchgen.pcc"
 394        if ((*set)[rule_no])
 395          {
 396 #line 225 "matchgen.pcc"
 397 #line 232 "matchgen.pcc"
 398          {
 399             MatchRule _V2 = rules->_1;
 400 #line 227 "matchgen.pcc"
 401
 402 #line 227 "matchgen.pcc"
 403 #line 231 "matchgen.pcc"
 404             {
 405                Cost _V3 = _V2->_4;
 406                if (_V3) {
 407                   if (untagp(_V3)) {
 408                      } else {
 409                      }
 410                } else {}
 411             }
 412 #line 231 "matchgen.pcc"
 413 #line 231 "matchgen.pcc"
 414
 415
 416 #line 232 "matchgen.pcc"
 417          }
 418 #line 233 "matchgen.pcc"
 419 #line 233 "matchgen.pcc"
 420
 421          }
 422          rules = rules->_2;
 423          rule_no++;
 424
 425 #line 237 "matchgen.pcc"
 426       } else { goto L4; }
 427    }
 428    L4:;
 429 }
 430 #line 238 "matchgen.pcc"
 431 #line 238 "matchgen.pcc"
 432
 433 }
 434
 435 ///////////////////////////////////////////////////////////////////////////////
 436 //
 437 //  Method to generate a switch statement for pattern matching.
 438 //  This method is responsible for generating optimized code for a one-level
 439 //  match using C++'s "switch" statement.
 440 //
 441 ///////////////////////////////////////////////////////////////////////////////
 442 void MatchCompiler::gen_switch
 443    (Id id, Exp e, Ty ty, int n, Cons terms[], Match m[], Match def, int shared,
 444     Bool variant, Bool boxed, TyOpt optimizations, Bool is_refutable)
 445 {
 446    if (n == 1) {          // only one arm
 447       gen(m[0]);
 448    } else if (n == 2) {   // two arms, use "if"
 449       if (m[0] == m[1]) {
 450          merges++; if (m[0] != FAILmatch) m[0]->shared -= shared; gen(m[0]);
 451       } else {
 452          ifs++;
 453          Id prefix, suffix;
 454          if (boxed) {
 455             if (optimizations & OPTtaggedpointer)
 456             { prefix = "untagp("; suffix = ")"; }
 457             else
 458             { prefix = ""; suffix = "->tag__"; }
 459          } else { prefix = suffix = ""; }
 460
 461          pr ("%^if (%s%e%s) {%+%^%m%-%?} else {%+%^%m%-%?}\n",
 462              prefix, e, suffix, m[1], m[0]);
 463       }
 464    } else {
 465       /////////////////////////////////////////////////////////////////////////
 466       //  The following is the general case for handling n-ary branches.
 467       /////////////////////////////////////////////////////////////////////////
 468       int i, j;
 469
 470       /////////////////////////////////////////////////////////////////////////
 471       // If all n branches are the same, eliminate the match
 472       /////////////////////////////////////////////////////////////////////////
 473       for (i = n - 1; i > 0; i--) if (m[i] != m[i-1]) break;
 474       if (i == 0) { if (m[0] != FAILmatch) m[0]->shared -= (n-1) * shared;
 475                     merges++; gen(m[0]); return;
 476                   }
 477
 478       switches++;
 479       Id prefix, suffix;
 480
 481       /////////////////////////////////////////////////////////////////////////
 482       // Generate the "switch" expression.
 483       /////////////////////////////////////////////////////////////////////////
 484       if (boxed) {
 485          if (optimizations & OPTtaggedpointer)
 486          { prefix = "untagp("; suffix = ")"; }
 487          else
 488          { prefix = ""; suffix = "->tag__"; }
 489       } else {
 490          if (variant)
 491          { prefix = "(int)"; suffix = ""; }
 492          else
 493          { prefix = suffix = ""; }
 494       }
 495       pr ("%^switch (%s%e%s) {\n%+", prefix, e, suffix);
 496
 497       /////////////////////////////////////////////////////////////////////////
 498       //  Partition the arms of the matches into alternatives with the
 499       //  same actions.  Sort the partitions in increasing sizes.
 500       /////////////////////////////////////////////////////////////////////////
 501       struct ConsMatch
 502       { Cons term; Match action; int tag; };
 503       struct MatchPartition
 504       { int count; Conses terms; Match action; int first_tag; };
 505       ConsMatch      * sorted  = (ConsMatch *)mem_pool.c_alloc
 506                                      (sizeof(ConsMatch) * n);
 507       MatchPartition * parts   = (MatchPartition *)mem_pool.c_alloc
 508                                      (sizeof(MatchPartition) * n);
 509       int number_of_parts = 0;
 510       {  for (i = 0; i < n; i++)
 511          {  sorted[i].term      = terms[i];
 512             sorted[i].action    = m[i];
 513             if (terms[i] != NOcons) sorted[i].tag = terms[i]->tag;
 514          }
 515
 516          // sort branches according the actions
 517          heapSort(ConsMatch, sorted, n,
 518                   (key.action < sorted[i].action ||
 519                    key.action == sorted[i].action &&
 520                    key.tag < sorted[i].tag));
 521
 522          // partition each branch by action
 523          for (i = n - 1; i >= 0; i--)
 524          {  if (i == n-1 || sorted[i].action != sorted[i+1].action)
 525             {  parts[number_of_parts].terms  =
 526 #line 331 "matchgen.pcc"
 527 #line 331 "matchgen.pcc"
 528 list_1_(sorted[i].term)
 529 #line 331 "matchgen.pcc"
 530 #line 331 "matchgen.pcc"
 531 ;
 532                parts[number_of_parts].action = sorted[i].action;
 533                parts[number_of_parts].count  = 1;
 534                parts[number_of_parts].first_tag = sorted[i].tag;
 535                number_of_parts++;
 536             } else {
 537                parts[number_of_parts-1].terms =
 538
 539 #line 338 "matchgen.pcc"
 540 #line 338 "matchgen.pcc"
 541 list_1_(sorted[i].term,parts[(number_of_parts - 1)].terms)
 542 #line 338 "matchgen.pcc"
 543 #line 338 "matchgen.pcc"
 544 ;
 545                parts[number_of_parts-1].count++;
 546                if (parts[number_of_parts-1].first_tag > sorted[i].tag)
 547                   parts[number_of_parts-1].first_tag = sorted[i].tag;
 548             }
 549          }
 550
 551          // Sort partitions in order of frequency; so that
 552          // the most frequent case becomes the "default" inside
 553          // the "switch" statement.
 554          heapSort(MatchPartition, parts, number_of_parts,
 555                   (key.count < parts[i].count ||
 556                    key.count == parts[i].count &&
 557                    key.first_tag < parts[i].first_tag));
 558       }
 559
 560       /////////////////////////////////////////////////////////////////////////
 561       // Generate the arms of the "switch".
 562       // We try to combine the arms that are the same together into
 563       // one rule to help the compiler.
 564       /////////////////////////////////////////////////////////////////////////
 565       for (i = 0; i < number_of_parts; i++)
 566       {  if (i == number_of_parts - 1) {
 567             pr ("%^default:");
 568          } else {
 569             Conses tags = parts[i].terms;
 570
 571 #line 364 "matchgen.pcc"
 572 #line 369 "matchgen.pcc"
 573 {
 574    for (;;) {
 575       if (tags) {
 576 #line 366 "matchgen.pcc"
 577        pr ("%^case %*:", tags->_1, false);
 578          if (tags->_2 !=
 579 #line 367 "matchgen.pcc"
 580 #line 367 "matchgen.pcc"
 581          nil_1_
 582 #line 367 "matchgen.pcc"
 583 #line 367 "matchgen.pcc"
 584          ) pr ("\n");
 585          tags = tags->_2;
 586
 587 #line 369 "matchgen.pcc"
 588       } else { goto L5; }
 589    }
 590    L5:;
 591 }
 592 #line 370 "matchgen.pcc"
 593 #line 370 "matchgen.pcc"
 594
 595          }
 596          if (parts[i].action != FAILmatch)
 597             parts[i].action->shared -= (parts[i].count - 1) * shared;
 598          pr (" {%+%?%m%?} break;\n%-", parts[i].action);
 599       }
 600
 601       pr ("%-%^}\n");
 602    }
 603 }
 604
 605 ///////////////////////////////////////////////////////////////////////////////
 606 //
 607 //  Generate binary search for testing literals
 608 //
 609 ///////////////////////////////////////////////////////////////////////////////
 610 void MatchCompiler::gen_binary_search_on_literals
 611    (Exp e, int n, Literal l[], Match m[], Match d)
 612 {  if (n <= 4) {
 613       /////////////////////////////////////////////////////////////////////////
 614       //  Generate linear tests for simple literal tests.
 615       /////////////////////////////////////////////////////////////////////////
 616       for (int i = 0; i < n; i++) {
 617          ifs++;
 618          if (i > 0) pr("%^else "); else pr ("%^");
 619          pr ("if (%=(%e,%l)) {%m}\n",l[i], e, l[i], m[i]);
 620       }
 621       if (d != FAILmatch) pr ("%^else {%m}\n", d);
 622       else if (current_failure) pr ("%^else goto %s;\n", current_failure);
 623    } else {
 624       /////////////////////////////////////////////////////////////////////////
 625       //  Generate binary search for tests containing many alternatives.
 626       /////////////////////////////////////////////////////////////////////////
 627       int k = (n+1)/2;
 628       ifs++;
 629       pr ("%^if (%<(%e,%l)) {\n%+", l[k], e, l[k]);
 630       gen_binary_search_on_literals(e,k,l,m,d);
 631       pr ("%-%^} else {\n%+");
 632       gen_binary_search_on_literals(e,n-k,l+k,m+k,d);
 633       pr ("%-%^}\n");
 634    }
 635 }
 636
 637 ///////////////////////////////////////////////////////////////////////////////
 638 //
 639 //  Generate range matching
 640 //
 641 ///////////////////////////////////////////////////////////////////////////////
 642 void MatchCompiler::gen_range_match
 643    (Pos pos, Exp e, int lo, int hi, Match a, Match b, Match m)
 644 {  if (lo == hi)
 645    {  switches++;
 646       pr ("%^switch (%e) {%+",e);
 647
 648 #line 423 "matchgen.pcc"
 649 #line 425 "matchgen.pcc"
 650 {
 651    for (;;) {
 652       if (boxed(m)) {
 653          switch (m->tag__) {
 654             case a_Match::tag_RANGEmatch: {
 655                if (
 656 #line 424 "matchgen.pcc"
 657                ((((Match_RANGEmatch *)m)->_3 == ((Match_RANGEmatch *)m)->_4) && pos_equal(pos,((Match_RANGEmatch *)m)->_1))
 658 #line 424 "matchgen.pcc"
 659 ) {
 660
 661 #line 425 "matchgen.pcc"
 662                  pr ("%^case %i: {%+%m%-%?} break;", ((Match_RANGEmatch *)m)->_3, ((Match_RANGEmatch *)m)->_5); m = ((Match_RANGEmatch *)m)->_6;
 663 #line 425 "matchgen.pcc"
 664                } else {
 665                    goto L6; }
 666                } break;
 667             default: { goto L6; } break;
 668          }
 669       } else { goto L6; }
 670    }
 671    L6:;
 672 }
 673 #line 426 "matchgen.pcc"
 674 #line 426 "matchgen.pcc"
 675
 676       pr ("%^default: {%+%m%-%?}"
 677           "%-%^}\n", m
 678          );
 679    } else
 680    {  ifs++;
 681       if (lo == 0) {
 682          pr ("%^if (%e <= %i) {%+%^%m%-%?} else {%+%^%m%-%?}\n",e,hi,a,b);
 683       } else if (hi == INT_MAX) {
 684          pr ("%^if (%e >= %i) {%+%^%m%-%?} else {%+%^%m%-%?}\n",e,lo,a,b);
 685       } else {
 686          pr ("%^if (%i <= %e && %e <= %i) {%+%^%m%-%?} else {%+%^%m%-%?}\n",
 687              lo,e,e,hi,a,b);
 688       }
 689    }
 690 }
 691
 692 ///////////////////////////////////////////////////////////////////////////////
 693 //
 694 //  Generate view matching
 695 //
 696 ///////////////////////////////////////////////////////////////////////////////
 697 void MatchCompiler::gen_view_match
 698    (Id id, Exp e, Exp view_match, int n, Cons terms [], Match m[], Match d,
 699     TyOpt opt, TyQual qual)
 700 {  if (view_match != NOexp)
 701    {  switches++;
 702       pr ("%^switch (%e) {%+", subst(view_match,&e));
 703       for (int i = 0; i < n; i++)
 704       {  pr ("%^case %e: {%+%m%-%?} break;", terms[i]->view_predicate, m[i]);
 705       }
 706       pr ("%-%^}\n");
 707    } else
 708    {  int i;
 709       for (i = 0; i < n; i++)
 710       {  int j;
 711          for (j = i + 1; j < n; j++) if (m[i] != m[j]) break;
 712          if (j == n) break;
 713          Exp predicate_fun = terms[i]->view_predicate;
 714          Exp predicate     = subst(predicate_fun,&e);
 715          ifs++;
 716          pr("%^%sif (%e) {%+%^%m%-%?} ",
 717             (i > 0 ? "else " : ""), predicate, m[i]);
 718       }
 719       if (i < n)
 720          pr ("%^%s{%+%^%m%-%?}\n", (i > 0 ? "else " : ""), m[i]);
 721    }
 722 }
 723
 724 ///////////////////////////////////////////////////////////////////////////////
 725 //
 726 //  Generate regular expression matching as a DFA.
 727 //
 728 ///////////////////////////////////////////////////////////////////////////////
 729 void MatchCompiler::gen_regexp_match
 730    (Exp e, int n, Literal l[], Match m[], Match d,
 731     MatchOptions options, Ty match_ty)
 732 {  LexerGen lexerGen;
 733    const char ** regexps = (const char **)mem_pool[n * sizeof(const char *)];
 734    const char ** contexts = 0;
 735
 736    ////////////////////////////////////////////////////////////////////////////
 737    //  If we have a match type, locate the set of contexts.
 738    ////////////////////////////////////////////////////////////////////////////
 739    if (options & MATCHscanner)
 740    {
 741 #line 491 "matchgen.pcc"
 742 #line 505 "matchgen.pcc"
 743 {
 744    Ty _V4 = deref_all(match_ty);
 745    if (_V4) {
 746       switch (_V4->tag__) {
 747          case a_Ty::tag_TYCONty: {
 748             if (boxed(((Ty_TYCONty *)_V4)->_1)) {
 749                switch (((Ty_TYCONty *)_V4)->_1->tag__) {
 750                   case a_TyCon::tag_DATATYPEtycon: {
 751 #line 494 "matchgen.pcc"
 752                    contexts = (const char **)mem_pool[(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->unit+1)*sizeof(const char *)];
 753                      if (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->unit <= 1)
 754                         msg("%L%wdatatype has less than 2 unit constructors for contexts");
 755                      for (int i = 1; i < ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->unit; i++)
 756                      {
 757 #line 498 "matchgen.pcc"
 758 #line 501 "matchgen.pcc"
 759                      {
 760                         Cons _V5 = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->terms[i];
 761                         if (_V5) {
 762 #line 499 "matchgen.pcc"
 763                           contexts[i-1] = _V5->name;
 764 #line 499 "matchgen.pcc"
 765                         } else {}
 766                      }
 767 #line 501 "matchgen.pcc"
 768 #line 501 "matchgen.pcc"
 769
 770                      }
 771                      contexts[((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V4)->_1)->unit-1] = 0;
 772
 773 #line 504 "matchgen.pcc"
 774                      } break;
 775                   default: {
 776                      L7:;
 777 #line 505 "matchgen.pcc"
 778                     error ("%Lillegal context type: %T\n", match_ty);
 779 #line 505 "matchgen.pcc"
 780                      } break;
 781                }
 782             } else { goto L7; }
 783             } break;
 784          default: { goto L7; } break;
 785       }
 786    } else {}
 787 }
 788 #line 506 "matchgen.pcc"
 789 #line 506 "matchgen.pcc"
 790
 791    }
 792
 793    ////////////////////////////////////////////////////////////////////////////
 794    //  Allocate a regexp array
 795    ////////////////////////////////////////////////////////////////////////////
 796    for (int i = 0; i < n; i++)
 797    {
 798 #line 513 "matchgen.pcc"
 799 #line 520 "matchgen.pcc"
 800 {
 801    Literal _V6 = l[i];
 802    switch (_V6->tag__) {
 803       case a_Literal::tag_REGEXPlit: {
 804 #line 515 "matchgen.pcc"
 805        int len           = strlen(((Literal_REGEXPlit *)_V6)->REGEXPlit);
 806          char * regexp     = str_pool(((Literal_REGEXPlit *)_V6)->REGEXPlit+1,len-1);
 807          regexp[len-2]     = '\0';
 808          regexps[i]        = regexp;
 809
 810 #line 519 "matchgen.pcc"
 811          } break;
 812       default: {
 813 #line 520 "matchgen.pcc"
 814         bug("gen_regexp_match");
 815 #line 520 "matchgen.pcc"
 816          } break;
 817    }
 818 }
 819 #line 521 "matchgen.pcc"
 820 #line 521 "matchgen.pcc"
 821
 822    }
 823
 824    int opt = LexerGen::None;
 825    if (options & MATCHscanner)
 826    {  opt |= LexerGen::Backtracking;
 827       debug_msg("%Lgenerating backtracking scanner\n");
 828    }
 829    if (options & MATCHcaseinsensitive) opt |= LexerGen::CaseInsensitive;
 830
 831    lexerGen.compile(n, regexps, contexts, 255, opt);
 832
 833    if (! lexerGen.ok()) {
 834       error ("%L%s in: %l\n", lexerGen.error_message(), l[lexerGen.bad()]);
 835    } else {
 836       /////////////////////////////////////////////////////////////////////////
 837       //  Generate the action code
 838       /////////////////////////////////////////////////////////////////////////
 839       Id id = vars.new_label();
 840       pr ("%^{\n%+");
 841       lexerGen.gen_code(*output, id);
 842       switches++;
 843       pr ("%^static const RegexMatch %s"
 844           "%^                 ( %s_base,"
 845           "%^                   %s_check,"
 846           "%^                   %s_def,"
 847           "%^                   %s_next,"
 848           "%^                   %s_accept_rule,"
 849           "%^                   %s_equiv_classes );\n",
 850           id, id, id, id, id, id, id);
 851       Id rule_binding = "";
 852       if (options & MATCHlexemepat)
 853       {  pr ("%^int rule__;");
 854          rule_binding = "rule__ = ";
 855       }
 856       if (options & MATCHscanner) {
 857          pr ("%^const char * next;\n"
 858              "%^switch(%s%s.MatchText(RegexMatch::start_state,%e,next)) {%+",
 859              rule_binding, id, e);
 860       } else {
 861          pr ("%^switch(%s%s.MatchText(%e)) {%+", rule_binding, id, e);
 862       }
 863       for (int i = 0; i < n; i++)
 864          pr ("%^case %i: {%+%m%-%?} break;", i+1, m[i]);
 865       pr ("%^default: {%+%m%-%?}", d);
 866       pr ("%-%^}\n"
 867           "%-%^}\n");
 868
 869       /////////////////////////////////////////////////////////////////////////
 870       //  Generate a report
 871       /////////////////////////////////////////////////////////////////////////
 872       if (::options.generate_report) lexerGen.print_report(open_logfile());
 873    }
 874 }
 875
 876 ///////////////////////////////////////////////////////////////////////////////
 877 //
 878 //  Generate quark pattern matching
 879 //
 880 ///////////////////////////////////////////////////////////////////////////////
 881 void MatchCompiler::gen_quark_match
 882    (Exp e, int n, Literal l[], Match m[], Match d, MatchOptions options)
 883 {  for (int i = 0; i < n; i++)
 884    {  ifs++;
 885       pr ("%^%sif (%e == %l) {%+%^%m%-%?} ",
 886           (i > 0 ? "else " : ""), e, l[i], m[i]);
 887    }
 888    pr ("%^%s{%+%^%m%-%?}\n", (n > 0 ? "else " : ""), d);
 889 }
 890
 891 ///////////////////////////////////////////////////////////////////////////////
 892 //
 893 //  Method to translate and merge a set of patterns
 894 //
 895 ///////////////////////////////////////////////////////////////////////////////
 896 Match MatchCompiler::trans_merge
 897    (int n, MatchRules rules, int match_options, Cost * costs)
 898 {  Match m = FAILmatch;
 899    int rule_no = 0;
 900    for_each(MatchRule, r, rules)
 901    {
 902 #line 601 "matchgen.pcc"
 903 #line 621 "matchgen.pcc"
 904 {
 905 #line 603 "matchgen.pcc"
 906  if (! r->is_chain_rule)
 907    {  Match rhs;
 908       if (match_options & (MATCHall | MATCHwithcost)) {
 909          BitSet * set = new (mem_pool,n) BitSet;
 910          set->add(rule_no);
 911          if (costs && ! (match_options & MATCHwithtreecost))
 912              rhs = COSTmatch(n,costs,set,rules);
 913          else
 914              rhs = SUCCESSESmatch(n,set,rules);
 915       } else {
 916          r->used = false; rhs = SUCCESSmatch(rule_no,r);
 917       }
 918       if (r->_3 != NOexp) rhs = GUARDmatch(r->_3,rhs,FAILmatch);
 919       rhs = trans(r->_2, POSzero, false, rhs, FAILmatch);
 920       debug_msg("%r => %M\n", r, rhs);
 921       m = merge (m, rhs);
 922    }
 923    rule_no++;
 924
 925 #line 621 "matchgen.pcc"
 926 }
 927 #line 622 "matchgen.pcc"
 928 #line 622 "matchgen.pcc"
 929
 930    }
 931    return m;
 932 }
 933
 934 ///////////////////////////////////////////////////////////////////////////////
 935 //
 936 //  Method to translate but do not merge a set of patterns.
 937 //  Use Wadler's algorithm.
 938 //
 939 ///////////////////////////////////////////////////////////////////////////////
 940 Match MatchCompiler::trans_no_merge
 941    (int n, int rule_no, MatchRules rules, int match_options, Cost * costs)
 942 {
 943    if (rules ==
 944 #line 636 "matchgen.pcc"
 945 #line 636 "matchgen.pcc"
 946 nil_1_
 947 #line 636 "matchgen.pcc"
 948 #line 636 "matchgen.pcc"
 949 ) return FAILmatch;
 950    else {
 951
 952 #line 638 "matchgen.pcc"
 953 #line 653 "matchgen.pcc"
 954 {
 955    MatchRule _V7 = rules->_1;
 956 #line 640 "matchgen.pcc"
 957  Match rhs;
 958    if (match_options & (MATCHall | MATCHwithcost)) {
 959       BitSet * set = new (mem_pool,n) BitSet;
 960       set->add(rule_no);
 961       if (costs) rhs = COSTmatch(n,costs,set,rules);
 962       else       rhs = SUCCESSESmatch(n,set,rules);
 963    } else {
 964       _V7->used = false; rhs = SUCCESSmatch(rule_no,_V7);
 965    }
 966    Match no =
 967       trans_no_merge(n, rule_no+1, rules->_2, match_options, costs);
 968    if (_V7->_3 != NOexp) rhs = GUARDmatch(_V7->_3,rhs,no);
 969    return trans(_V7->_2, POSzero, false, rhs, no);
 970
 971 #line 653 "matchgen.pcc"
 972 }
 973 #line 654 "matchgen.pcc"
 974 #line 654 "matchgen.pcc"
 975
 976    }
 977 }
 978
 979 ///////////////////////////////////////////////////////////////////////////////
 980 //
 981 //  Instrument the matching code if tracing is on
 982 //
 983 ///////////////////////////////////////////////////////////////////////////////
 984 void MatchCompiler::instrument_trace(MatchRules rules)
 985 {  for_each(MatchRule, r, rules)
 986    {
 987 #line 665 "matchgen.pcc"
 988 #line 682 "matchgen.pcc"
 989 {
 990 #line 667 "matchgen.pcc"
 991  char buffer[4096];
 992    std::ostrstream stream(buffer, sizeof(buffer));
 993    std::ostream& s = stream;
 994    s << r << std::ends;
 995    r->_5 =
 996
 997 #line 672 "matchgen.pcc"
 998 #line 672 "matchgen.pcc"
 999    list_1_(EXPdecl(APPexp(IDexp("PROP_TRACE"),TUPLEexp(list_1_(LITERALexp(STRINGlit(make_quoted_string(buffer))),list_1_(LITERALexp(STRINGlit(make_quoted_string(r->file_name))),list_1_(LITERALexp(INTlit(r->begin_line)))))))),list_1_(OPAQUEdecl(";"),r->_5))
1000 #line 681 "matchgen.pcc"
1001 #line 681 "matchgen.pcc"
1002    ;
1003
1004 #line 682 "matchgen.pcc"
1005 }
1006 #line 683 "matchgen.pcc"
1007 #line 683 "matchgen.pcc"
1008
1009    }
1010 }
1011
1012 ///////////////////////////////////////////////////////////////////////////////
1013 //
1014 //  Compute the match dag from a set of pattern matching rules.
1015 //
1016 ///////////////////////////////////////////////////////////////////////////////
1017 Match MatchCompiler::match_of
1018    (int n, MatchRules rules, MatchOptions match_options)
1019 {  Match m;
1020
1021    ////////////////////////////////////////////////////////////////////////////
1022    //  Save the last index map.
1023    ////////////////////////////////////////////////////////////////////////////
1024    HashTable * last_index_map = current_index_map;
1025
1026    ////////////////////////////////////////////////////////////////////////////
1027    //  Create index map for this pattern set if necessary.
1028    ////////////////////////////////////////////////////////////////////////////
1029    if (options.adaptive_matching) {
1030       debug_msg("Creating index map\n");
1031       current_index_map = new HashTable(pos_hash, pos_equal, 129);
1032       indexing(rules, *current_index_map);
1033       debug_msg("Finished indexing\n");
1034    } else {
1035       current_index_map = 0;
1036    }
1037
1038    ////////////////////////////////////////////////////////////////////////////
1039    //  If tracing is on, instrument the code.
1040    ////////////////////////////////////////////////////////////////////////////
1041    if (options.trace && (match_options & MATCHnotrace) == 0)
1042       instrument_trace(rules);
1043
1044    ////////////////////////////////////////////////////////////////////////////
1045    //  Make a cost vector if cost minimization is in effect
1046    ////////////////////////////////////////////////////////////////////////////
1047    Cost * cost_vector = 0;
1048    if (match_options & MATCHwithintcost)
1049    {  cost_vector = (Cost*)mem_pool[n * sizeof(Cost)];
1050       int i = 0;
1051       for_each(MatchRule, r, rules)
1052       {
1053 #line 727 "matchgen.pcc"
1054 #line 728 "matchgen.pcc"
1055 {
1056 #line 728 "matchgen.pcc"
1057   cost_vector[i] = r->_4; i++;
1058 #line 728 "matchgen.pcc"
1059 }
1060 #line 728 "matchgen.pcc"
1061 #line 728 "matchgen.pcc"
1062
1063       }
1064    }
1065
1066    ////////////////////////////////////////////////////////////////////////////
1067    //  Translate each pattern into a matching tree and merge them together.
1068    ////////////////////////////////////////////////////////////////////////////
1069    if (merge_match)
1070       m = trans_merge(n, rules, match_options, cost_vector);
1071    else
1072       m = trans_no_merge(n, 0, rules, match_options, cost_vector);
1073
1074    m = make_dag (m, match_options, rules);
1075    debug_msg("Matching DFA: %M\n", m);
1076
1077    ////////////////////////////////////////////////////////////////////////////
1078    // Error checking.
1079    ////////////////////////////////////////////////////////////////////////////
1080    // BUG 3/6/97: Always check for selectability!!!
1081    if (true || (match_options & MATCHnocheck) == 0) {
1082       if (match_options & (MATCHall | MATCHwithcost)) {
1083          BitSet * may_match = new (mem_pool,n) BitSet;
1084          matchables(m,*may_match);
1085          int i = 0;
1086          for_each (MatchRule, r, rules)
1087          {  if (! may_match->contains(i) && ! r->is_chain_rule)
1088                error("%!this rule is never selected: %r\n", r->loc(), r);
1089             i++;
1090          }
1091       } else {
1092          {  for_each (MatchRule,r,rules)
1093             {  if (! r->used)
1094                   error ("%!this rule is never used: %r\n", r->loc(), r);
1095             }
1096          }
1097       }
1098    }
1099
1100    ////////////////////////////////////////////////////////////////////////////
1101    //  Clean up the index map
1102    ////////////////////////////////////////////////////////////////////////////
1103    if (current_index_map) delete current_index_map;
1104    current_index_map = last_index_map;
1105    return m;
1106 }
1107
1108 ///////////////////////////////////////////////////////////////////////////////
1109 //
1110 //  Returns true if the set of rules involve cost expressions.
1111 //
1112 ///////////////////////////////////////////////////////////////////////////////
1113 int involve_cost(MatchRules rules)
1114 {  int options = MATCHnone;
1115    for_each(MatchRule, r, rules)
1116    {
1117 #line 782 "matchgen.pcc"
1118 #line 788 "matchgen.pcc"
1119 {
1120    if (r->_4) {
1121       if (untagp(r->_4)) {
1122
1123 #line 784 "matchgen.pcc"
1124         options |= MATCHwithcost | MATCHwithintcost;
1125 #line 784 "matchgen.pcc"
1126       } else {
1127
1128 #line 786 "matchgen.pcc"
1129         options |= MATCHwithcost | MATCHwithexpcost;
1130 #line 786 "matchgen.pcc"
1131       }
1132    } else {}
1133 }
1134 #line 788 "matchgen.pcc"
1135 #line 788 "matchgen.pcc"
1136
1137    }
1138    return options;
1139 }
1140
1141 ///////////////////////////////////////////////////////////////////////////////
1142 //
1143 //  Method to check for refutable set of rules and print out
1144 //  warning/error messages.
1145 //
1146 ///////////////////////////////////////////////////////////////////////////////
1147 static Bool check_refutable
1148    (Match m, MatchRules rules, MatchOptions match_options)
1149 {   Bool is_refutable = refutable(m);            // error checking
1150     if (! (match_options & MATCHnocheck) &&
1151         ! (match_options & MATCHwhile) && is_refutable) {
1152       msg ("%!%wpatterns are not exhaustive:\n", rules->_1->loc());
1153       for_each(MatchRule,r,rules) msg("%!\t%r\n", r->loc(), r);
1154     }
1155     return is_refutable;
1156 }
1157
1158 ///////////////////////////////////////////////////////////////////////////////
1159 //
1160 //  Compile a match/matchall statement.
1161 //
1162 ///////////////////////////////////////////////////////////////////////////////
1163 void MatchCompiler::gen_match_stmt
1164    (MatchExps exps, MatchRules rules, MatchOptions match_options, Ty match_ty)
1165 {  MemPoolMark marker = mem_pool.getMark();     // set heap marker
1166    int n              = length(rules);
1167    Ty pattern_tys     = type_match_rules(rules);    // type inference
1168    Id save_failure    = current_failure;
1169    current_failure    = 0;
1170    MatchOptions save  = current_options;
1171    current_options    = match_options;
1172
1173    if (pattern_tys != NOty) {
1174       pr ("%^{\n%+");
1175       if (match_options & MATCHwhile) {
1176          pr ("%^for (;;) {%+"); current_failure = labels.new_label();
1177       }
1178
1179       // check for cost expressions
1180       int cost_opts = involve_cost(rules);
1181       if (cost_opts & MATCHwithcost) {
1182          if (match_options & MATCHall)
1183             if (! (match_options & MATCHwithtreecost))
1184                msg ("%L%wmatching costs are ignored.\n");
1185          else
1186             match_options |= cost_opts;
1187       }
1188
1189       Match m = match_of(n, rules, match_options); // compile patterns
1190       Bool is_refutable = check_refutable(m, rules, match_options);
1191
1192       // prefix code for matchall
1193       if ((match_options & (MATCHall | MATCHwithcost)) &&
1194           ! (match_options & MATCHwithtreecost))
1195          pr ("%^const unsigned char * m__%s;\n", (is_refutable ? " = 0" : ""));
1196
1197       gen_match_variables(exps, pattern_tys);
1198       gen(m, match_options, match_ty);
1199
1200       // suffix code for cost minimization
1201       if (! (match_options & MATCHwithtreecost))
1202       {  if (match_options & MATCHwithexpcost)
1203             gen_match_cost_minimization(n, m, rules, is_refutable);
1204
1205          // suffix code for matchall
1206          else if (match_options & MATCHall)
1207             gen_matchall_suffix(n, m, rules, is_refutable);
1208       }
1209
1210       if (match_options & MATCHwhile)
1211       {  pr ("%-%^}");
1212          if (is_refutable) pr("%^%s:;", current_failure);
1213       }
1214       pr ("%-%^}");
1215    }
1216    mem_pool.setMark(marker); // release all memory used
1217    current_failure = save_failure;
1218    current_options = save;
1219 }
1220
1221 ///////////////////////////////////////////////////////////////////////////////
1222 //
1223 //  Generate suffix code for a matchall statement.
1224 //  The suffix code goes thru the bitmap and select all rule with
1225 //  its bit set.
1226 //
1227 ///////////////////////////////////////////////////////////////////////////////
1228 void MatchCompiler::gen_matchall_suffix
1229    (int n, Match m, MatchRules rules, Bool is_refutable)
1230 {  int index = 0; int bit = 0;
1231    const BitSet& always_match = always_matchables(m,n);
1232    if (is_refutable) { ifs++; pr ("%^if (m__) {%+"); }
1233
1234    for_each (MatchRule, r, rules)
1235    {
1236 #line 887 "matchgen.pcc"
1237 #line 898 "matchgen.pcc"
1238 {
1239 #line 889 "matchgen.pcc"
1240  if (! always_match.contains(index * 8 + bit)) {
1241    ifs++;
1242    pr ("%^if (m__[%i] & %i) ", index, 1 << bit);
1243    } else {
1244    pr ("%^");
1245    }
1246             MarkCurrentRule mark(current_rule,r);
1247    pr ("{%+%&%-%?}\n", r->_5);
1248    if (++bit == 8) { bit = 0; index++; }
1249
1250 #line 898 "matchgen.pcc"
1251 }
1252 #line 899 "matchgen.pcc"
1253 #line 899 "matchgen.pcc"
1254
1255    }
1256    if (is_refutable) pr ("%-%^}");
1257 }
1258
1259 ///////////////////////////////////////////////////////////////////////////////
1260 //
1261 //  Generate suffix code for a match statement with cost minimization.
1262 //  The bitmap selected with determine which cost function to execute.
1263 //  When all the appropriate cost functions are executed, we choose the
1264 //  matched rule with the lowest cost.  Ties are broken by the lexical
1265 //  order of the rules.
1266 //
1267 ///////////////////////////////////////////////////////////////////////////////
1268 void MatchCompiler::gen_match_cost_minimization
1269    (int n, Match m, MatchRules rules, Bool is_refutable)
1270 {  int index, bit;
1271    const BitSet& always_match = always_matchables(m,n);
1272
1273    pr ("%^do {%+"
1274        "%^int tmp_cost__, cost__ = %i, rule__ = -1;", MAX_COST);
1275    if (is_refutable) { ifs++; pr ("%^if (m__) {%+"); }
1276    {  index = bit = 0;
1277       for_each (MatchRule, r, rules)
1278       {  pr ("%^");
1279          if (! always_match.contains(index * 8 + bit)) {
1280             ifs++;
1281             pr ("if (m__[%i] & %i) ", index, 1 << bit);
1282          }
1283          int rule_no = index * 8 + bit;
1284
1285 #line 929 "matchgen.pcc"
1286 #line 937 "matchgen.pcc"
1287 {
1288    if (r->_4) {
1289       if (untagp(r->_4)) {
1290
1291 #line 937 "matchgen.pcc"
1292        pr ("if (cost__ > %i) { cost__ = %i; rule__ = %i; }", ((Cost_INTcost *)derefp(r->_4))->INTcost, ((Cost_INTcost *)derefp(r->_4))->INTcost, rule_no);
1293 #line 937 "matchgen.pcc"
1294       } else {
1295
1296 #line 931 "matchgen.pcc"
1297        pr ("if ((tmp_cost__ = %e) < cost__) { cost__ = tmp_cost__; rule_ = %i; }",
1298          ((Cost_EXPcost *)r->_4)->_1, rule_no);
1299
1300 #line 933 "matchgen.pcc"
1301       }
1302    } else {
1303 #line 935 "matchgen.pcc"
1304     pr ("{ rule__ = %i; break; }", rule_no);
1305 #line 935 "matchgen.pcc"
1306    }
1307 }
1308 #line 938 "matchgen.pcc"
1309 #line 938 "matchgen.pcc"
1310
1311          if (++bit == 8) { bit = 0; index++; }
1312       }
1313    }
1314    if (is_refutable) pr ("%-%^}");
1315    pr ("%-%^} while (0);"
1316        "%^switch (rule__) {%+");
1317    {  int i = 0;
1318       for_each(MatchRule, r, rules)
1319       {
1320 #line 947 "matchgen.pcc"
1321 #line 952 "matchgen.pcc"
1322 {
1323 #line 949 "matchgen.pcc"
1324  MarkCurrentRule mark(current_rule,r);
1325    pr ("%^case %i: {%+%&%-%?} break;", i, r->_5);
1326                i++;
1327
1328 #line 952 "matchgen.pcc"
1329 }
1330 #line 953 "matchgen.pcc"
1331 #line 953 "matchgen.pcc"
1332
1333       }
1334    }
1335    pr ("%-%^}");
1336 }
1337
1338 ///////////////////////////////////////////////////////////////////////////////
1339 //
1340 //  Generate code that binds match variables.
1341 //
1342 ///////////////////////////////////////////////////////////////////////////////
1343 void MatchCompiler::gen_match_variables(MatchExps es, Ty ty)
1344 {  Tys tys;
1345    if (length(es) > 1) {
1346
1347 #line 967 "matchgen.pcc"
1348 #line 969 "matchgen.pcc"
1349 {
1350    Ty _V8 = deref(ty);
1351    if (_V8) {
1352       switch (_V8->tag__) {
1353          case a_Ty::tag_TYCONty: {
1354             if (boxed(((Ty_TYCONty *)_V8)->_1)) {
1355                L8:;
1356 #line 969 "matchgen.pcc"
1357               bug("gen_match_variables()");
1358 #line 969 "matchgen.pcc"
1359             } else {
1360                switch ((int)((Ty_TYCONty *)_V8)->_1) {
1361                   case ((int)TUPLEtycon): {
1362 #line 968 "matchgen.pcc"
1363                     tys = ((Ty_TYCONty *)_V8)->_2;
1364 #line 968 "matchgen.pcc"
1365                      } break;
1366                   default: { goto L8; } break;
1367                }
1368             }
1369             } break;
1370          default: { goto L8; } break;
1371       }
1372    } else { goto L8; }
1373 }
1374 #line 970 "matchgen.pcc"
1375 #line 970 "matchgen.pcc"
1376
1377    } else {
1378       tys =
1379 #line 972 "matchgen.pcc"
1380 #line 972 "matchgen.pcc"
1381 list_1_(ty)
1382 #line 972 "matchgen.pcc"
1383 #line 972 "matchgen.pcc"
1384 ;
1385    }
1386    for ( ; es && tys; es = es->_2, tys = tys->_2) {
1387
1388 #line 975 "matchgen.pcc"
1389 #line 982 "matchgen.pcc"
1390 {
1391    MatchExp _V9 = es->_1;
1392    if (
1393 #line 976 "matchgen.pcc"
1394    (_V9->_2 != 0)
1395 #line 976 "matchgen.pcc"
1396 ) {
1397
1398 #line 977 "matchgen.pcc"
1399     if (! is_ground(tys->_1))
1400       error ("%!missing type info in expression %e : %T\n",
1401              _V9->loc(), _V9->_1, tys->_1);
1402       pr ("%^%t = %e;\n", tys->_1, _V9->_2, _V9->_1);
1403
1404 #line 981 "matchgen.pcc"
1405    } else {
1406
1407 #line 982 "matchgen.pcc"
1408      /* skip */
1409 #line 982 "matchgen.pcc"
1410    }
1411 }
1412 #line 983 "matchgen.pcc"
1413 #line 983 "matchgen.pcc"
1414
1415    }
1416 }
1417
1418 ///////////////////////////////////////////////////////////////////////////////
1419 //
1420 //  Generate code for a set of function definitions.
1421 //
1422 ///////////////////////////////////////////////////////////////////////////////
1423 void MatchCompiler::gen_fun_def (FunDefs fundefs)
1424 {  // Generate the prototype first (to deal with recursive definitions).
1425    MemPoolMark marker = mem_pool.getMark();     // set heap marker
1426    {  for_each (FunDef, f, fundefs)
1427       {
1428 #line 996 "matchgen.pcc"
1429 #line 1009 "matchgen.pcc"
1430 {
1431 #line 998 "matchgen.pcc"
1432  f->_2 = type_match_rules(f->_4);
1433    char buf[1024];
1434    std::ostrstream b(buf,sizeof(buf));
1435    std::ostream& s = b;
1436    s << f->_1 << std::ends;
1437    Ty ret_ty = f->_3 == NOty ? void_ty : f->_3;
1438    pr ("%^%t %b;\n",
1439        ret_ty, buf, f->_2, "1", TYformal);
1440    if (! is_ground(f->_2))
1441       error ("%!missing type info in function %q %T\n",
1442              f->loc(), f->_1, f->_2);
1443
1444 #line 1009 "matchgen.pcc"
1445 }
1446 #line 1010 "matchgen.pcc"
1447 #line 1010 "matchgen.pcc"
1448
1449       }
1450    }
1451
1452    // Then generate the body of the functions.
1453    {  for_each (FunDef, f, fundefs)
1454       {
1455 #line 1016 "matchgen.pcc"
1456 #line 1030 "matchgen.pcc"
1457 {
1458 #line 1018 "matchgen.pcc"
1459  int n = length(f->_4);
1460    Match m = match_of(n, f->_4, MATCHnone);
1461    check_refutable(m, f->_4, MATCHnone);
1462    Ty ret_ty = f->_3 == NOty ? void_ty : f->_3;
1463    char buf[1024];
1464    std::ostrstream b(buf,sizeof(buf));
1465    std::ostream& s = b;
1466    s << f->_1 << std::ends;
1467    pr ("%^%t %b\n{\n%+",
1468        ret_ty, buf, f->_2, "1", TYformal);
1469    gen(m);
1470    pr ("%-%^}\n");
1471
1472 #line 1030 "matchgen.pcc"
1473 }
1474 #line 1031 "matchgen.pcc"
1475 #line 1031 "matchgen.pcc"
1476
1477       }
1478    }
1479    mem_pool.setMark(marker); // release all memory used
1480 }
1481 #line 1036 "matchgen.pcc"
1482 /*
1483 ------------------------------- Statistics -------------------------------
1484 Merge matching rules         = yes
1485 Number of DFA nodes merged   = 147
1486 Number of ifs generated      = 23
1487 Number of switches generated = 14
1488 Number of labels             = 4
1489 Number of gotos              = 12
1490 Adaptive matching            = enabled
1491 Fast string matching         = disabled
1492 Inline downcasts             = enabled
1493 --------------------------------------------------------------------------
1494 */