prop-src/pat.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 "pat.pcc".
   5 ///////////////////////////////////////////////////////////////////////////////
   6
   7 #line 1 "pat.pcc"
   8 ///////////////////////////////////////////////////////////////////////////////
   9 //
  10 //  This file implements the analysis routines for patterns and match
  11 //  decision trees.  These are used for mode analysis and determinism
  12 //  analysis for logic clauses compilation.
  13 //
  14 ///////////////////////////////////////////////////////////////////////////////
  15 #include "ir.h"
  16 #include "matchcom.h"
  17 #include "pat.h"
  18
  19 ///////////////////////////////////////////////////////////////////////////////
  20 //
  21 //  Convert a pattern into an unifier if the constructor is part of
  22 //  an unifiable type.
  23 //
  24 ///////////////////////////////////////////////////////////////////////////////
  25 Pat mkunifier (Cons cons, Pat pat, Pat transformed_pat)
  26 {
  27 #line 19 "pat.pcc"
  28 #line 31 "pat.pcc"
  29 {
  30    if (cons) {
  31       if (cons->alg_ty) {
  32          switch (cons->alg_ty->tag__) {
  33             case a_Ty::tag_TYCONty: {
  34                if (boxed(((Ty_TYCONty *)cons->alg_ty)->_1)) {
  35                   switch (((Ty_TYCONty *)cons->alg_ty)->_1->tag__) {
  36                      case a_TyCon::tag_DATATYPEtycon: {
  37                         if (
  38 #line 21 "pat.pcc"
  39                         (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->qualifiers & QUALunifiable)
  40 #line 21 "pat.pcc"
  41 ) {
  42
  43 #line 22 "pat.pcc"
  44                          Cons unifier_cons = ((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->terms[((TyCon_DATATYPEtycon *)((Ty_TYCONty *)cons->alg_ty)->_1)->unit];
  45                            Bool mode_save = write_mode;
  46                            write_mode = true;
  47                            Pat new_p = LOGICALpat(ORpat,transformed_pat,
  48                                           UNIFYpat(APPpat(CONSpat(unifier_cons),WILDpat()),
  49                                                    pat2unifier(pat)));
  50                            write_mode = mode_save;
  51                            return new_p;
  52
  53 #line 30 "pat.pcc"
  54                         } else {
  55
  56                            L1:;
  57 #line 31 "pat.pcc"
  58                           return pat;
  59 #line 31 "pat.pcc"
  60                         }
  61                         } break;
  62                      default: { goto L1; } break;
  63                   }
  64                } else { goto L1; }
  65                } break;
  66             default: { goto L1; } break;
  67          }
  68       } else { goto L1; }
  69    } else { goto L1; }
  70 }
  71 #line 32 "pat.pcc"
  72 #line 32 "pat.pcc"
  73
  74 }
  75
  76 ///////////////////////////////////////////////////////////////////////////////
  77 //
  78 //  Convert a simple pattern into an unifier.
  79 //
  80 ///////////////////////////////////////////////////////////////////////////////
  81 Pat unifier_of (Pat pat)
  82 {  Pat new_p = pat;
  83
  84 #line 42 "pat.pcc"
  85 #line 72 "pat.pcc"
  86 {
  87    if (pat) {
  88       switch (pat->tag__) {
  89          case a_Pat::tag_CONSpat: {
  90 #line 45 "pat.pcc"
  91            new_p = mkunifier(((Pat_CONSpat *)pat)->CONSpat,pat,pat);
  92 #line 45 "pat.pcc"
  93             } break;
  94          case a_Pat::tag_APPpat: {
  95             if (((Pat_APPpat *)pat)->_1) {
  96                switch (((Pat_APPpat *)pat)->_1->tag__) {
  97                   case a_Pat::tag_CONSpat: {
  98 #line 47 "pat.pcc"
  99                     new_p = mkunifier(((Pat_CONSpat *)((Pat_APPpat *)pat)->_1)->CONSpat,pat,APPpat(((Pat_APPpat *)pat)->_1,unifier_of(((Pat_APPpat *)pat)->_2)));
 100 #line 47 "pat.pcc"
 101                      } break;
 102                   default: {
 103                      L2:;
 104 #line 72 "pat.pcc"
 105                     bug ("%Lunsupported unifier: %p", pat);
 106 #line 72 "pat.pcc"
 107                      } break;
 108                }
 109             } else { goto L2; }
 110             } break;
 111          case a_Pat::tag_TYPEDpat: {
 112 #line 48 "pat.pcc"
 113            new_p = TYPEDpat(unifier_of(((Pat_TYPEDpat *)pat)->_1),((Pat_TYPEDpat *)pat)->_2);
 114 #line 48 "pat.pcc"
 115             } break;
 116          case a_Pat::tag_ASpat: {
 117 #line 49 "pat.pcc"
 118            new_p = ASpat(((Pat_ASpat *)pat)->_1,unifier_of(((Pat_ASpat *)pat)->_2),((Pat_ASpat *)pat)->_3,((Pat_ASpat *)pat)->_4);
 119 #line 49 "pat.pcc"
 120             } break;
 121          case a_Pat::tag_ARRAYpat: {
 122 #line 50 "pat.pcc"
 123            new_p = ARRAYpat(unifier_of(((Pat_ARRAYpat *)pat)->_1),((Pat_ARRAYpat *)pat)->_2);
 124 #line 50 "pat.pcc"
 125             } break;
 126          case a_Pat::tag_TUPLEpat: {
 127 #line 51 "pat.pcc"
 128            new_p = TUPLEpat(unifier_of(((Pat_TUPLEpat *)pat)->TUPLEpat));
 129 #line 51 "pat.pcc"
 130             } break;
 131          case a_Pat::tag_EXTUPLEpat: {
 132 #line 52 "pat.pcc"
 133            new_p = EXTUPLEpat(unifier_of(((Pat_EXTUPLEpat *)pat)->EXTUPLEpat));
 134 #line 52 "pat.pcc"
 135             } break;
 136          case a_Pat::tag_RECORDpat: {
 137 #line 53 "pat.pcc"
 138            new_p = RECORDpat(unifier_of(((Pat_RECORDpat *)pat)->_1),((Pat_RECORDpat *)pat)->_2);
 139 #line 53 "pat.pcc"
 140             } break;
 141          case a_Pat::tag_LISTpat: {
 142 #line 56 "pat.pcc"
 143            new_p =
 144 #line 56 "pat.pcc"
 145 #line 56 "pat.pcc"
 146             LISTpat(((Pat_LISTpat *)pat)->cons, ((Pat_LISTpat *)pat)->nil, unifier_of(((Pat_LISTpat *)pat)->head), unifier_of(((Pat_LISTpat *)pat)->tail))
 147 #line 58 "pat.pcc"
 148 #line 58 "pat.pcc"
 149             ;
 150
 151 #line 59 "pat.pcc"
 152             } break;
 153          case a_Pat::tag_VECTORpat: {
 154 #line 61 "pat.pcc"
 155            new_p =
 156 #line 61 "pat.pcc"
 157 #line 61 "pat.pcc"
 158             VECTORpat(((Pat_VECTORpat *)pat)->cons, unifier_of(((Pat_VECTORpat *)pat)->len), unifier_of(((Pat_VECTORpat *)pat)->array), unifier_of(((Pat_VECTORpat *)pat)->elements), ((Pat_VECTORpat *)pat)->head_flex, ((Pat_VECTORpat *)pat)->tail_flex)
 159 #line 67 "pat.pcc"
 160 #line 67 "pat.pcc"
 161             ;
 162
 163 #line 68 "pat.pcc"
 164             } break;
 165          case a_Pat::tag_GUARDpat: {
 166 #line 54 "pat.pcc"
 167            new_p = GUARDpat(unifier_of(((Pat_GUARDpat *)pat)->_1),((Pat_GUARDpat *)pat)->_2);
 168 #line 54 "pat.pcc"
 169             } break;
 170          case a_Pat::tag_LOGICALpat: {
 171 #line 70 "pat.pcc"
 172            new_p = LOGICALpat(((Pat_LOGICALpat *)pat)->_1,unifier_of(((Pat_LOGICALpat *)pat)->_2),unifier_of(((Pat_LOGICALpat *)pat)->_3));
 173 #line 70 "pat.pcc"
 174             } break;
 175          case a_Pat::tag_MARKEDpat: {
 176 #line 71 "pat.pcc"
 177            new_p = MARKEDpat(((Pat_MARKEDpat *)pat)->_1, unifier_of(((Pat_MARKEDpat *)pat)->_2));
 178 #line 71 "pat.pcc"
 179             } break;
 180          case a_Pat::tag_WILDpat:
 181          case a_Pat::tag_IDpat:
 182          case a_Pat::tag_LITERALpat:
 183          case a_Pat::tag_CONTEXTpat:
 184          case a_Pat::tag_LEXEMEpat: {
 185             L3:; } break;
 186          default: { goto L2; } break;
 187       }
 188    } else { goto L3; }
 189 }
 190 #line 73 "pat.pcc"
 191 #line 73 "pat.pcc"
 192
 193    if (new_p != pat && boxed(pat) && boxed(new_p))
 194    {  new_p->selector = pat->selector;
 195       new_p->ty       = pat->ty;
 196    }
 197    return new_p;
 198 }
 199
 200 ///////////////////////////////////////////////////////////////////////////////
 201 //
 202 //  Convert a simple pattern list into an unifier list.
 203 //
 204 ///////////////////////////////////////////////////////////////////////////////
 205 Pats unifier_of (Pats pats)
 206 {
 207 #line 87 "pat.pcc"
 208 #line 89 "pat.pcc"
 209 {
 210    if (pats) {
 211 #line 89 "pat.pcc"
 212      return
 213 #line 89 "pat.pcc"
 214 #line 89 "pat.pcc"
 215       list_1_(unifier_of(pats->_1),unifier_of(pats->_2))
 216 #line 89 "pat.pcc"
 217 #line 89 "pat.pcc"
 218       ;
 219 #line 89 "pat.pcc"
 220    } else {
 221 #line 88 "pat.pcc"
 222      return
 223 #line 88 "pat.pcc"
 224 #line 88 "pat.pcc"
 225       nil_1_
 226 #line 88 "pat.pcc"
 227 #line 88 "pat.pcc"
 228       ;
 229 #line 88 "pat.pcc"
 230    }
 231 }
 232 #line 90 "pat.pcc"
 233 #line 90 "pat.pcc"
 234
 235 }
 236
 237 ///////////////////////////////////////////////////////////////////////////////
 238 //
 239 //  Convert a simple labeled pattern list into an labeled unifier list.
 240 //
 241 ///////////////////////////////////////////////////////////////////////////////
 242 LabPats unifier_of (LabPats pats)
 243 {
 244 #line 99 "pat.pcc"
 245 #line 105 "pat.pcc"
 246 {
 247    if (pats) {
 248 #line 101 "pat.pcc"
 249      LabPat lab_pat;
 250       lab_pat.label = pats->_1.label;
 251       lab_pat.pat   = unifier_of(pats->_1.pat);
 252       return
 253 #line 104 "pat.pcc"
 254 #line 104 "pat.pcc"
 255       list_1_(lab_pat,unifier_of(pats->_2))
 256 #line 104 "pat.pcc"
 257 #line 104 "pat.pcc"
 258       ;
 259
 260 #line 105 "pat.pcc"
 261    } else {
 262 #line 100 "pat.pcc"
 263      return
 264 #line 100 "pat.pcc"
 265 #line 100 "pat.pcc"
 266       nil_1_
 267 #line 100 "pat.pcc"
 268 #line 100 "pat.pcc"
 269       ;
 270 #line 100 "pat.pcc"
 271    }
 272 }
 273 #line 106 "pat.pcc"
 274 #line 106 "pat.pcc"
 275
 276 }
 277 ///////////////////////////////////////////////////////////////////////////////
 278 //
 279 //  Check whether pattern a subsumes b, i.e. more general.
 280 //
 281 ///////////////////////////////////////////////////////////////////////////////
 282 Bool subsumes (Pat a, Pat b, Bool v)
 283 {
 284 #line 114 "pat.pcc"
 285 #line 128 "pat.pcc"
 286 {
 287    if (a) {
 288       switch (a->tag__) {
 289          case a_Pat::tag_CONSpat: {
 290             if (b) {
 291                switch (b->tag__) {
 292                   case a_Pat::tag_CONSpat: {
 293 #line 124 "pat.pcc"
 294                     return ((Pat_CONSpat *)a)->CONSpat == ((Pat_CONSpat *)b)->CONSpat;
 295 #line 124 "pat.pcc"
 296                      } break;
 297                   case a_Pat::tag_TYPEDpat: {
 298                      L4:;
 299 #line 123 "pat.pcc"
 300                     return subsumes(a,((Pat_TYPEDpat *)b)->_1,v);
 301 #line 123 "pat.pcc"
 302                      } break;
 303                   case a_Pat::tag_ASpat: {
 304                      L5:;
 305 #line 121 "pat.pcc"
 306                     return subsumes(a,((Pat_ASpat *)b)->_2,v);
 307 #line 121 "pat.pcc"
 308                      } break;
 309                   default: {
 310                      L6:;
 311 #line 128 "pat.pcc"
 312                     return false;
 313 #line 128 "pat.pcc"
 314                      } break;
 315                }
 316             } else { goto L6; }
 317             } break;
 318          case a_Pat::tag_APPpat: {
 319             if (b) {
 320                switch (b->tag__) {
 321                   case a_Pat::tag_APPpat: {
 322 #line 125 "pat.pcc"
 323                     return subsumes(((Pat_APPpat *)a)->_1,((Pat_APPpat *)b)->_1,v) && subsumes(((Pat_APPpat *)a)->_2,((Pat_APPpat *)b)->_2,v);
 324 #line 125 "pat.pcc"
 325                      } break;
 326                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 327                   case a_Pat::tag_ASpat: { goto L5; } break;
 328                   default: { goto L6; } break;
 329                }
 330             } else { goto L6; }
 331             } break;
 332          case a_Pat::tag_TYPEDpat: {
 333             if (b) {
 334                switch (b->tag__) {
 335                   case a_Pat::tag_ASpat: { goto L5; } break;
 336                   default: {
 337                      L7:;
 338 #line 122 "pat.pcc"
 339                     return subsumes(((Pat_TYPEDpat *)a)->_1,b,v);
 340 #line 122 "pat.pcc"
 341                      } break;
 342                }
 343             } else { goto L7; }
 344             } break;
 345          case a_Pat::tag_ASpat: {
 346 #line 120 "pat.pcc"
 347            return subsumes(((Pat_ASpat *)a)->_2,b,v);
 348 #line 120 "pat.pcc"
 349             } break;
 350          case a_Pat::tag_LITERALpat: {
 351             if (b) {
 352                switch (b->tag__) {
 353                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 354                   case a_Pat::tag_ASpat: { goto L5; } break;
 355                   case a_Pat::tag_LITERALpat: {
 356 #line 117 "pat.pcc"
 357                     return literal_equal(((Pat_LITERALpat *)a)->LITERALpat,((Pat_LITERALpat *)b)->LITERALpat);
 358 #line 117 "pat.pcc"
 359                      } break;
 360                   default: { goto L6; } break;
 361                }
 362             } else { goto L6; }
 363             } break;
 364          case a_Pat::tag_TUPLEpat: {
 365             if (b) {
 366                switch (b->tag__) {
 367                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 368                   case a_Pat::tag_ASpat: { goto L5; } break;
 369                   case a_Pat::tag_TUPLEpat: {
 370 #line 118 "pat.pcc"
 371                     return subsumes(((Pat_TUPLEpat *)a)->TUPLEpat,((Pat_TUPLEpat *)b)->TUPLEpat,v);
 372 #line 118 "pat.pcc"
 373                      } break;
 374                   default: { goto L6; } break;
 375                }
 376             } else { goto L6; }
 377             } break;
 378          case a_Pat::tag_EXTUPLEpat: {
 379             if (b) {
 380                switch (b->tag__) {
 381                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 382                   case a_Pat::tag_ASpat: { goto L5; } break;
 383                   case a_Pat::tag_EXTUPLEpat: {
 384 #line 119 "pat.pcc"
 385                     return subsumes(((Pat_EXTUPLEpat *)a)->EXTUPLEpat,((Pat_EXTUPLEpat *)b)->EXTUPLEpat,v);
 386 #line 119 "pat.pcc"
 387                      } break;
 388                   default: { goto L6; } break;
 389                }
 390             } else { goto L6; }
 391             } break;
 392          case a_Pat::tag_GUARDpat: {
 393             if (b) {
 394                switch (b->tag__) {
 395                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 396                   case a_Pat::tag_ASpat: { goto L5; } break;
 397                   case a_Pat::tag_GUARDpat: {
 398 #line 126 "pat.pcc"
 399                     return subsumes(((Pat_GUARDpat *)a)->_1,((Pat_GUARDpat *)b)->_1,v) && equal(((Pat_GUARDpat *)a)->_2,((Pat_GUARDpat *)b)->_2);
 400 #line 126 "pat.pcc"
 401                      } break;
 402                   default: { goto L6; } break;
 403                }
 404             } else { goto L6; }
 405             } break;
 406          case a_Pat::tag_LOGICALpat: {
 407             if (b) {
 408                switch (b->tag__) {
 409                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 410                   case a_Pat::tag_ASpat: { goto L5; } break;
 411                   default: {
 412                      L8:;
 413                      switch (((Pat_LOGICALpat *)a)->_1) {
 414                         case ORpat: {
 415                            L9:;
 416 #line 127 "pat.pcc"
 417                           return subsumes(((Pat_LOGICALpat *)a)->_2,b,v) && subsumes(((Pat_LOGICALpat *)a)->_3,b,v);
 418 #line 127 "pat.pcc"
 419                            } break;
 420                         default: { goto L6; } break;
 421                      }
 422                      } break;
 423                }
 424             } else { goto L8; }
 425             } break;
 426          case a_Pat::tag_BACKEDGEpat: {
 427 #line 116 "pat.pcc"
 428            return subsumes(((Pat_BACKEDGEpat *)a)->_3,b,v);
 429 #line 116 "pat.pcc"
 430             } break;
 431          case a_Pat::tag_WILDpat:
 432          case a_Pat::tag_IDpat: {
 433 #line 115 "pat.pcc"
 434            return true;
 435 #line 115 "pat.pcc"
 436             } break;
 437          default: {
 438             L10:;
 439             if (b) {
 440                switch (b->tag__) {
 441                   case a_Pat::tag_TYPEDpat: { goto L4; } break;
 442                   case a_Pat::tag_ASpat: { goto L5; } break;
 443                   default: { goto L6; } break;
 444                }
 445             } else { goto L6; }
 446             } break;
 447       }
 448    } else { goto L10; }
 449 }
 450 #line 129 "pat.pcc"
 451 #line 129 "pat.pcc"
 452
 453 }
 454
 455 ///////////////////////////////////////////////////////////////////////////////
 456 //
 457 //  Checks whether list a subsumes list b.  Subsumption is computed
 458 //  componentwise.
 459 //
 460 ///////////////////////////////////////////////////////////////////////////////
 461 Bool subsumes (Pats a, Pats b, Bool v)
 462 {
 463 #line 139 "pat.pcc"
 464 #line 142 "pat.pcc"
 465 {
 466    if (a) {
 467       if (b) {
 468 #line 141 "pat.pcc"
 469         return subsumes(a->_1,b->_1,v) && subsumes(a->_2,b->_2,v);
 470 #line 141 "pat.pcc"
 471       } else {
 472          L11:;
 473 #line 142 "pat.pcc"
 474         return false;
 475 #line 142 "pat.pcc"
 476       }
 477    } else {
 478       if (b) { goto L11; } else {
 479 #line 140 "pat.pcc"
 480         return true;
 481 #line 140 "pat.pcc"
 482       }
 483    }
 484 }
 485 #line 143 "pat.pcc"
 486 #line 143 "pat.pcc"
 487
 488 }
 489
 490 ///////////////////////////////////////////////////////////////////////////////
 491 //
 492 //  Computes the subsumption info for two labeled pat lists.
 493 //
 494 ///////////////////////////////////////////////////////////////////////////////
 495 Bool subsumes (LabPats, LabPats, Bool verbose)
 496 {  return false;
 497 }
 498 #line 154 "pat.pcc"
 499 /*
 500 ------------------------------- Statistics -------------------------------
 501 Merge matching rules         = yes
 502 Number of DFA nodes merged   = 751
 503 Number of ifs generated      = 21
 504 Number of switches generated = 15
 505 Number of labels             = 11
 506 Number of gotos              = 41
 507 Adaptive matching            = enabled
 508 Fast string matching         = disabled
 509 Inline downcasts             = enabled
 510 --------------------------------------------------------------------------
 511 */