prop-src/lawgen.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 "lawgen.pcc".
   5 ///////////////////////////////////////////////////////////////////////////////
   6
   7 #define PROP_TUPLE2_USED
   8 #include <propdefs.h>
   9 #line 1 "lawgen.pcc"
  10 ///////////////////////////////////////////////////////////////////////////////
  11 //
  12 //  Module to generate law abbreviations.
  13 //
  14 ///////////////////////////////////////////////////////////////////////////////
  15 #include "ir.h"
  16 #include "ast.h"
  17 #include "datagen.h"
  18 #include "type.h"
  19 #include "hashtab.h"
  20 #include "list.h"
  21
  22 ///////////////////////////////////////////////////////////////////////////////
  23 //
  24 //  Law environment.
  25 //
  26 ///////////////////////////////////////////////////////////////////////////////
  27 HashTable DatatypeCompiler::law_env(string_hash,string_equal);
  28
  29 ///////////////////////////////////////////////////////////////////////////////
  30 //
  31 //  Method to lookup a pattern law.
  32 //
  33 ///////////////////////////////////////////////////////////////////////////////
  34 Pat DatatypeCompiler::lookup_pat (Id id)
  35 {  HashTable::Entry * e = law_env.lookup(id);
  36    return e ? (Pat)e->v : NOpat;
  37 }
  38
  39 ///////////////////////////////////////////////////////////////////////////////
  40 //
  41 //  Method to enter a new pattern
  42 //
  43 ///////////////////////////////////////////////////////////////////////////////
  44 void DatatypeCompiler::add_law(LawDef law_def)
  45 {
  46 #line 36 "lawgen.pcc"
  47 #line 46 "lawgen.pcc"
  48 {
  49 #line 38 "lawgen.pcc"
  50  if (lookup_pat(law_def->id) != NOpat) {
  51    error ("%Lduplicated definition of pattern constructor '%s'\n",law_def->id);
  52    } else {
  53    // type check pattern
  54    Pat p = law_def->guard != NOexp ? GUARDpat(p,law_def->guard) : law_def->pat;
  55    law_env.insert(law_def->id, POLYpat(law_def->id, length(law_def->args), law_def->args, p, law_def->guard,
  56                            law_def->invert));
  57          }
  58
  59 #line 46 "lawgen.pcc"
  60 }
  61 #line 47 "lawgen.pcc"
  62 #line 47 "lawgen.pcc"
  63
  64 }
  65
  66 ///////////////////////////////////////////////////////////////////////////////
  67 //
  68 //  Function 'invertible' checks whether a pattern is invertible into
  69 //  a pseudo constructor.
  70 //
  71 ///////////////////////////////////////////////////////////////////////////////
  72 #line 56 "lawgen.pcc"
  73 #line 82 "lawgen.pcc"
  74 Bool invertible (Pat x_1);
  75 Bool invertible (a_List<Pat> *  x_1);
  76 Bool invertible (a_List<LabPat> *  x_1);
  77 Bool invertible (Pat x_1)
  78 {
  79    if (x_1) {
  80       switch (x_1->tag__) {
  81          case a_Pat::tag_APPpat: {
  82             if (((Pat_APPpat *)x_1)->_1) {
  83                switch (((Pat_APPpat *)x_1)->_1->tag__) {
  84                   case a_Pat::tag_CONSpat: {
  85 #line 60 "lawgen.pcc"
  86                     return invertible(((Pat_APPpat *)x_1)->_2);
  87 #line 60 "lawgen.pcc"
  88                      } break;
  89                   default: {
  90                      L1:;
  91 #line 75 "lawgen.pcc"
  92                     bug("invertible: %p", x_1); return false;
  93 #line 75 "lawgen.pcc"
  94                      } break;
  95                }
  96             } else { goto L1; }
  97             } break;
  98          case a_Pat::tag_TYPEDpat: {
  99 #line 61 "lawgen.pcc"
 100            return invertible(((Pat_TYPEDpat *)x_1)->_1);
 101 #line 61 "lawgen.pcc"
 102             } break;
 103          case a_Pat::tag_ASpat: {
 104 #line 62 "lawgen.pcc"
 105            return invertible(((Pat_ASpat *)x_1)->_2);
 106 #line 62 "lawgen.pcc"
 107             } break;
 108          case a_Pat::tag_CONTEXTpat: {
 109 #line 63 "lawgen.pcc"
 110            return invertible(((Pat_CONTEXTpat *)x_1)->_2);
 111 #line 63 "lawgen.pcc"
 112             } break;
 113          case a_Pat::tag_TUPLEpat: {
 114 #line 64 "lawgen.pcc"
 115            return invertible(((Pat_TUPLEpat *)x_1)->TUPLEpat);
 116 #line 64 "lawgen.pcc"
 117             } break;
 118          case a_Pat::tag_EXTUPLEpat: {
 119 #line 65 "lawgen.pcc"
 120            return invertible(((Pat_EXTUPLEpat *)x_1)->EXTUPLEpat);
 121 #line 65 "lawgen.pcc"
 122             } break;
 123          case a_Pat::tag_RECORDpat: {
 124 #line 66 "lawgen.pcc"
 125            return ! ((Pat_RECORDpat *)x_1)->_2 && invertible(((Pat_RECORDpat *)x_1)->_1);
 126 #line 66 "lawgen.pcc"
 127             } break;
 128          case a_Pat::tag_LISTpat: {
 129 #line 70 "lawgen.pcc"
 130            return invertible(((Pat_LISTpat *)x_1)->head) && invertible(((Pat_LISTpat *)x_1)->tail);
 131 #line 70 "lawgen.pcc"
 132             } break;
 133          case a_Pat::tag_VECTORpat: {
 134 #line 72 "lawgen.pcc"
 135            return ! ((Pat_VECTORpat *)x_1)->head_flex && ! ((Pat_VECTORpat *)x_1)->tail_flex &&
 136             invertible(((Pat_VECTORpat *)x_1)->len) && invertible(((Pat_VECTORpat *)x_1)->array) && invertible(((Pat_VECTORpat *)x_1)->elements);
 137
 138 #line 74 "lawgen.pcc"
 139             } break;
 140          case a_Pat::tag_GUARDpat: {
 141 #line 67 "lawgen.pcc"
 142            return invertible(((Pat_GUARDpat *)x_1)->_1);
 143 #line 67 "lawgen.pcc"
 144             } break;
 145          case a_Pat::tag_MARKEDpat: {
 146 #line 68 "lawgen.pcc"
 147            return invertible(((Pat_MARKEDpat *)x_1)->_2);
 148 #line 68 "lawgen.pcc"
 149             } break;
 150          case a_Pat::tag_WILDpat:
 151          case a_Pat::tag_ARRAYpat:
 152          case a_Pat::tag_APPENDpat:
 153          case a_Pat::tag_LOGICALpat: {
 154 #line 59 "lawgen.pcc"
 155            return false;
 156 #line 59 "lawgen.pcc"
 157             } break;
 158          case a_Pat::tag_INDpat:
 159          case a_Pat::tag_IDpat:
 160          case a_Pat::tag_CONSpat:
 161          case a_Pat::tag_LITERALpat: {
 162             L2:;
 163 #line 57 "lawgen.pcc"
 164            return true;
 165 #line 57 "lawgen.pcc"
 166             } break;
 167          default: { goto L1; } break;
 168       }
 169    } else { goto L2; }
 170 }
 171 Bool invertible (a_List<Pat> *  x_1)
 172 {
 173    if (x_1) {
 174 #line 78 "lawgen.pcc"
 175      return invertible(x_1->_1) && invertible(x_1->_2);
 176 #line 78 "lawgen.pcc"
 177    } else {
 178 #line 77 "lawgen.pcc"
 179      return true;
 180 #line 77 "lawgen.pcc"
 181    }
 182 }
 183 Bool invertible (a_List<LabPat> *  x_1)
 184 {
 185    if (x_1) {
 186 #line 81 "lawgen.pcc"
 187      return invertible(x_1->_1.pat) && invertible(x_1->_2);
 188 #line 81 "lawgen.pcc"
 189    } else {
 190 #line 80 "lawgen.pcc"
 191      return true;
 192 #line 80 "lawgen.pcc"
 193    }
 194 }
 195 #line 82 "lawgen.pcc"
 196 #line 82 "lawgen.pcc"
 197
 198
 199 ///////////////////////////////////////////////////////////////////////////////
 200 //
 201 //  Function to convert a pattern into a variable creation expression.
 202 //
 203 ///////////////////////////////////////////////////////////////////////////////
 204 Exp mkvariable (Pat p)
 205 {
 206 #line 90 "lawgen.pcc"
 207 #line 96 "lawgen.pcc"
 208 {
 209    Ty _V1 = deref_all(p->ty);
 210    if (_V1) {
 211       switch (_V1->tag__) {
 212          case a_Ty::tag_TYCONty: {
 213             if (boxed(((Ty_TYCONty *)_V1)->_1)) {
 214                switch (((Ty_TYCONty *)_V1)->_1->tag__) {
 215                   case a_TyCon::tag_DATATYPEtycon: {
 216                      if (
 217 #line 92 "lawgen.pcc"
 218                      (((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->qualifiers & QUALunifiable)
 219 #line 92 "lawgen.pcc"
 220 ) {
 221
 222 #line 93 "lawgen.pcc"
 223                       return APPexp(IDexp(((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->terms[((TyCon_DATATYPEtycon *)((Ty_TYCONty *)_V1)->_1)->unit]->name),TUPLEexp(
 224 #line 93 "lawgen.pcc"
 225 #line 93 "lawgen.pcc"
 226                         nil_1_
 227 #line 93 "lawgen.pcc"
 228 #line 93 "lawgen.pcc"
 229                         ));
 230 #line 93 "lawgen.pcc"
 231                      } else {
 232
 233                         L3:;
 234 #line 94 "lawgen.pcc"
 235                        error("%L%p with type %T is not unifiable\n", p, p->ty);
 236                         return NOexp;
 237
 238 #line 96 "lawgen.pcc"
 239                      }
 240                      } break;
 241                   default: { goto L3; } break;
 242                }
 243             } else { goto L3; }
 244             } break;
 245          default: { goto L3; } break;
 246       }
 247    } else { goto L3; }
 248 }
 249 #line 97 "lawgen.pcc"
 250 #line 97 "lawgen.pcc"
 251
 252 }
 253
 254 ///////////////////////////////////////////////////////////////////////////////
 255 //
 256 //  Function 'pat2exp' converts an invertible pattern into a
 257 //  constructor expression.  Also extracts the bound variable bindings
 258 //  at the same time.
 259 //
 260 ///////////////////////////////////////////////////////////////////////////////
 261 static
 262 #line 107 "lawgen.pcc"
 263 a_List<Tuple2<Id, Ty> > *
 264 #line 107 "lawgen.pcc"
 265  boundvars =
 266 #line 107 "lawgen.pcc"
 267 nil_1_
 268 #line 107 "lawgen.pcc"
 269 #line 107 "lawgen.pcc"
 270 ;
 271 static Exps           actual_args =
 272 #line 108 "lawgen.pcc"
 273 #line 108 "lawgen.pcc"
 274 nil_1_
 275 #line 108 "lawgen.pcc"
 276 #line 108 "lawgen.pcc"
 277 ;
 278 static Bool           application_error = false;
 279 Bool   write_mode = false;
 280
 281 #line 112 "lawgen.pcc"
 282 #line 173 "lawgen.pcc"
 283 Exp pat2exp (Pat x_1);
 284 Exps pat2exp (a_List<Pat> *  x_1);
 285 LabExps pat2exp (a_List<LabPat> *  x_1);
 286 Exp pat2constructor (Pat x_1);
 287 Exp pat2unifier (Pat x_1);
 288 Exp pat2exp (Pat x_1)
 289 {
 290    if (x_1) {
 291       switch (x_1->tag__) {
 292          case a_Pat::tag_WILDpat: {
 293             if (write_mode) {
 294
 295 #line 145 "lawgen.pcc"
 296               return mkvariable(x_1);
 297 #line 145 "lawgen.pcc"
 298             } else {
 299
 300                L4:;
 301 #line 146 "lawgen.pcc"
 302               bug("pat2exp: %p", x_1); return NOexp;
 303 #line 146 "lawgen.pcc"
 304             }
 305             } break;
 306          case a_Pat::tag_INDpat: {
 307             if ((actual_args != nil_1_)) {
 308
 309 #line 116 "lawgen.pcc"
 310              int k = 0;
 311                for_each(Exp, e, actual_args)
 312                {  if (k == ((Pat_INDpat *)x_1)->_2) return e;
 313                   k++;
 314                }
 315                   error("%LMissing argument %i in law variable %s\n",((Pat_INDpat *)x_1)->_2,((Pat_INDpat *)x_1)->_1);
 316                application_error = true;
 317                return NOexp;
 318
 319 #line 124 "lawgen.pcc"
 320             } else {
 321
 322 #line 126 "lawgen.pcc"
 323               boundvars =
 324 #line 126 "lawgen.pcc"
 325 #line 126 "lawgen.pcc"
 326                list_1_(mkTuple2(((Pat_INDpat *)x_1)->_1,((Pat_INDpat *)x_1)->_3),boundvars)
 327 #line 126 "lawgen.pcc"
 328 #line 126 "lawgen.pcc"
 329                ;
 330                return IDexp(((Pat_INDpat *)x_1)->_1);
 331
 332 #line 128 "lawgen.pcc"
 333             }
 334             } break;
 335          case a_Pat::tag_IDpat: {
 336 #line 114 "lawgen.pcc"
 337            return write_mode ? mkvariable(x_1) : IDexp(((Pat_IDpat *)x_1)->_1);
 338 #line 114 "lawgen.pcc"
 339             } break;
 340          case a_Pat::tag_CONSpat: {
 341             if (((Pat_CONSpat *)x_1)->CONSpat) {
 342 #line 138 "lawgen.pcc"
 343               return IDexp(((Pat_CONSpat *)x_1)->CONSpat->name);
 344 #line 138 "lawgen.pcc"
 345             } else { goto L4; }
 346             } break;
 347          case a_Pat::tag_APPpat: {
 348             if (((Pat_APPpat *)x_1)->_1) {
 349                switch (((Pat_APPpat *)x_1)->_1->tag__) {
 350                   case a_Pat::tag_CONSpat: {
 351 #line 139 "lawgen.pcc"
 352                     return CONSexp(((Pat_CONSpat *)((Pat_APPpat *)x_1)->_1)->CONSpat,
 353 #line 139 "lawgen.pcc"
 354 #line 139 "lawgen.pcc"
 355                      nil_1_
 356 #line 139 "lawgen.pcc"
 357 #line 139 "lawgen.pcc"
 358                      ,pat2exp(((Pat_APPpat *)x_1)->_2));
 359 #line 139 "lawgen.pcc"
 360                      } break;
 361                   default: { goto L4; } break;
 362                }
 363             } else { goto L4; }
 364             } break;
 365          case a_Pat::tag_TYPEDpat: {
 366 #line 130 "lawgen.pcc"
 367            return pat2exp(((Pat_TYPEDpat *)x_1)->_1);
 368 #line 130 "lawgen.pcc"
 369             } break;
 370          case a_Pat::tag_ASpat: {
 371 #line 131 "lawgen.pcc"
 372            return pat2exp(((Pat_ASpat *)x_1)->_2);
 373 #line 131 "lawgen.pcc"
 374             } break;
 375          case a_Pat::tag_LITERALpat: {
 376 #line 129 "lawgen.pcc"
 377            return LITERALexp(((Pat_LITERALpat *)x_1)->LITERALpat);
 378 #line 129 "lawgen.pcc"
 379             } break;
 380          case a_Pat::tag_CONTEXTpat: {
 381 #line 132 "lawgen.pcc"
 382            return pat2exp(((Pat_CONTEXTpat *)x_1)->_2);
 383 #line 132 "lawgen.pcc"
 384             } break;
 385          case a_Pat::tag_TUPLEpat: {
 386 #line 133 "lawgen.pcc"
 387            return TUPLEexp(pat2exp(((Pat_TUPLEpat *)x_1)->TUPLEpat));
 388 #line 133 "lawgen.pcc"
 389             } break;
 390          case a_Pat::tag_EXTUPLEpat: {
 391 #line 134 "lawgen.pcc"
 392            return EXTUPLEexp(pat2exp(((Pat_EXTUPLEpat *)x_1)->EXTUPLEpat));
 393 #line 134 "lawgen.pcc"
 394             } break;
 395          case a_Pat::tag_RECORDpat: {
 396 #line 135 "lawgen.pcc"
 397            return RECORDexp(pat2exp(((Pat_RECORDpat *)x_1)->_1));
 398 #line 135 "lawgen.pcc"
 399             } break;
 400          case a_Pat::tag_LISTpat: {
 401 #line 141 "lawgen.pcc"
 402            return LISTexp(((Pat_LISTpat *)x_1)->cons,((Pat_LISTpat *)x_1)->nil,pat2exp(((Pat_LISTpat *)x_1)->head),pat2exp(((Pat_LISTpat *)x_1)->tail));
 403 #line 141 "lawgen.pcc"
 404             } break;
 405          case a_Pat::tag_VECTORpat: {
 406 #line 143 "lawgen.pcc"
 407            return VECTORexp(((Pat_VECTORpat *)x_1)->cons,pat2exp(((Pat_VECTORpat *)x_1)->elements));
 408 #line 143 "lawgen.pcc"
 409             } break;
 410          case a_Pat::tag_GUARDpat: {
 411 #line 136 "lawgen.pcc"
 412            return pat2exp(((Pat_GUARDpat *)x_1)->_1);
 413 #line 136 "lawgen.pcc"
 414             } break;
 415          case a_Pat::tag_MARKEDpat: {
 416 #line 137 "lawgen.pcc"
 417            return pat2exp(((Pat_MARKEDpat *)x_1)->_2);
 418 #line 137 "lawgen.pcc"
 419             } break;
 420          default: { goto L4; } break;
 421       }
 422    } else {
 423 #line 112 "lawgen.pcc"
 424      return NOexp;
 425 #line 112 "lawgen.pcc"
 426    }
 427 }
 428 Exps pat2exp (a_List<Pat> *  x_1)
 429 {
 430    if (x_1) {
 431 #line 149 "lawgen.pcc"
 432      return
 433 #line 149 "lawgen.pcc"
 434 #line 149 "lawgen.pcc"
 435       list_1_(pat2exp(x_1->_1),pat2exp(x_1->_2))
 436 #line 149 "lawgen.pcc"
 437 #line 149 "lawgen.pcc"
 438       ;
 439 #line 149 "lawgen.pcc"
 440    } else {
 441 #line 148 "lawgen.pcc"
 442      return
 443 #line 148 "lawgen.pcc"
 444 #line 148 "lawgen.pcc"
 445       nil_1_
 446 #line 148 "lawgen.pcc"
 447 #line 148 "lawgen.pcc"
 448       ;
 449 #line 148 "lawgen.pcc"
 450    }
 451 }
 452 LabExps pat2exp (a_List<LabPat> *  x_1)
 453 {
 454    if (x_1) {
 455 #line 152 "lawgen.pcc"
 456      LabExp labexp;
 457       labexp.label = x_1->_1.label;
 458       labexp.exp   = pat2exp(x_1->_1.pat);
 459       return
 460 #line 155 "lawgen.pcc"
 461 #line 155 "lawgen.pcc"
 462       list_1_(labexp,pat2exp(x_1->_2))
 463 #line 155 "lawgen.pcc"
 464 #line 155 "lawgen.pcc"
 465       ;
 466
 467 #line 156 "lawgen.pcc"
 468    } else {
 469 #line 151 "lawgen.pcc"
 470      return
 471 #line 151 "lawgen.pcc"
 472 #line 151 "lawgen.pcc"
 473       nil_1_
 474 #line 151 "lawgen.pcc"
 475 #line 151 "lawgen.pcc"
 476       ;
 477 #line 151 "lawgen.pcc"
 478    }
 479 }
 480 Exp pat2constructor (Pat x_1)
 481 {
 482 #line 159 "lawgen.pcc"
 483  Bool mode_save = write_mode;
 484    write_mode = false;
 485    Exp  e = pat2exp(x_1);
 486    write_mode = mode_save;
 487    return e;
 488
 489 #line 164 "lawgen.pcc"
 490 }
 491 Exp pat2unifier (Pat x_1)
 492 {
 493 #line 167 "lawgen.pcc"
 494  Bool mode_save = write_mode;
 495    write_mode = true;
 496    Exp  e = pat2exp(x_1);
 497    write_mode = mode_save;
 498    return e;
 499
 500 #line 172 "lawgen.pcc"
 501 }
 502 #line 173 "lawgen.pcc"
 503 #line 173 "lawgen.pcc"
 504
 505
 506 ///////////////////////////////////////////////////////////////////////////////
 507 //
 508 //  Method to lookup a pattern law.
 509 //
 510 ///////////////////////////////////////////////////////////////////////////////
 511 Exp DatatypeCompiler::lookup_law (Id id, Exps args)
 512 {  Pat pat = lookup_pat(id);
 513
 514 #line 182 "lawgen.pcc"
 515 #line 204 "lawgen.pcc"
 516 {
 517    if (pat) {
 518       switch (pat->tag__) {
 519          case a_Pat::tag_POLYpat: {
 520             if (
 521 #line 183 "lawgen.pcc"
 522             (((Pat_POLYpat *)pat)->_6 == true)
 523 #line 183 "lawgen.pcc"
 524 ) {
 525
 526 #line 184 "lawgen.pcc"
 527              {  if (invertible(((Pat_POLYpat *)pat)->_4) && ((Pat_POLYpat *)pat)->_5 == NOexp)
 528                {  actual_args = args;
 529                        application_error = false;
 530                        if (((Pat_POLYpat *)pat)->_2 != length(args))
 531                   {  error("%Larity mismatch between law %p and arguments %f\n",
 532                                 ((Pat_POLYpat *)pat)->_4, TUPLEexp(args));
 533                      return NOexp;
 534                   }
 535                   Exp exp = pat2exp(((Pat_POLYpat *)pat)->_4);
 536                   actual_args =
 537 #line 193 "lawgen.pcc"
 538 #line 193 "lawgen.pcc"
 539                nil_1_
 540 #line 193 "lawgen.pcc"
 541 #line 193 "lawgen.pcc"
 542                ;
 543                        if (application_error)
 544                                  error("%Lcannot apply law %p with arguments %f\n",
 545                                 ((Pat_POLYpat *)pat)->_4, TUPLEexp(args));
 546                               return exp;
 547                            } else
 548                            {  error ("%Llaw %s(...) = %p is not invertible\n",((Pat_POLYpat *)pat)->_1,((Pat_POLYpat *)pat)->_4);
 549                            }
 550                         }
 551
 552 #line 202 "lawgen.pcc"
 553             } else {
 554
 555                L5:; }
 556             } break;
 557          default: { goto L5; } break;
 558       }
 559    } else { goto L5; }
 560 }
 561 #line 204 "lawgen.pcc"
 562 #line 204 "lawgen.pcc"
 563
 564    return NOexp;
 565 }
 566
 567 ///////////////////////////////////////////////////////////////////////////////
 568 //
 569 //  Method to generate pattern law definitions
 570 //
 571 ///////////////////////////////////////////////////////////////////////////////
 572 void DatatypeCompiler::gen_law_defs (LawDefs law_defs)
 573 {
 574    for_each (LawDef, l, law_defs)
 575    {
 576 #line 216 "lawgen.pcc"
 577 #line 234 "lawgen.pcc"
 578 {
 579 #line 218 "lawgen.pcc"
 580  l->set_loc();
 581
 582                // infer the type of the pattern.
 583                l->ty = type_of(l->pat);
 584
 585                // If the law is invertible, generate
 586                // code for the laws
 587                if (l->invert)
 588                {  if (invertible(l->pat) && l->guard == NOexp)
 589                   {  boundvars =
 590 #line 227 "lawgen.pcc"
 591 #line 227 "lawgen.pcc"
 592    nil_1_
 593 #line 227 "lawgen.pcc"
 594 #line 227 "lawgen.pcc"
 595    ;
 596    gen_law_inverse(l->loc(),l->id,l->args,pat2constructor(l->pat),l->ty);
 597    boundvars =
 598 #line 229 "lawgen.pcc"
 599 #line 229 "lawgen.pcc"
 600    nil_1_
 601 #line 229 "lawgen.pcc"
 602 #line 229 "lawgen.pcc"
 603    ;
 604    } else
 605    {  error ("%Llaw %s(...) = %p is not invertible\n",l->id,l->pat);
 606    }
 607    }
 608
 609 #line 234 "lawgen.pcc"
 610 }
 611 #line 235 "lawgen.pcc"
 612 #line 235 "lawgen.pcc"
 613
 614    }
 615 }
 616
 617 ///////////////////////////////////////////////////////////////////////////////
 618 //
 619 //  Check if type can be a C++ parameter
 620 //
 621 ///////////////////////////////////////////////////////////////////////////////
 622 Bool is_parameter_type (Ty ty)
 623 {
 624 #line 245 "lawgen.pcc"
 625 #line 247 "lawgen.pcc"
 626 {
 627    Ty _V2 = deref(ty);
 628    if (_V2) {
 629       switch (_V2->tag__) {
 630          case a_Ty::tag_TYCONty: {
 631             if (boxed(((Ty_TYCONty *)_V2)->_1)) {
 632                switch (((Ty_TYCONty *)_V2)->_1->tag__) {
 633                   case a_TyCon::tag_RECORDtycon:
 634                   case a_TyCon::tag_ARRAYtycon: {
 635                      L6:;
 636 #line 246 "lawgen.pcc"
 637                      return false;
 638 #line 246 "lawgen.pcc"
 639                      } break;
 640                   default: {
 641                      L7:;
 642 #line 247 "lawgen.pcc"
 643                      return true;
 644 #line 247 "lawgen.pcc"
 645                      } break;
 646                }
 647             } else {
 648                switch ((int)((Ty_TYCONty *)_V2)->_1) {
 649                   case ((int)TUPLEtycon): { goto L6; } break;
 650                   default: { goto L7; } break;
 651                }
 652             }
 653             } break;
 654          default: { goto L7; } break;
 655       }
 656    } else { goto L7; }
 657 }
 658 #line 248 "lawgen.pcc"
 659 #line 248 "lawgen.pcc"
 660
 661 }
 662
 663
 664 ///////////////////////////////////////////////////////////////////////////////
 665 //
 666 //  Method to generate an inverse for a law definition
 667 //
 668 ///////////////////////////////////////////////////////////////////////////////
 669 void DatatypeCompiler::gen_law_inverse
 670    (const Loc * location, Id id, Ids args, Exp exp, Ty ty)
 671 {   // Generate the header name
 672     pr("%^%/"
 673        "%^// Definition of law %s"
 674        "%^%/"
 675        "%#"
 676        "%^inline %t(",
 677        id, location->begin_line, location->file_name, ty, id);
 678
 679     // Generate the parameters
 680     Bool comma = false;
 681
 682 #line 269 "lawgen.pcc"
 683 #line 295 "lawgen.pcc"
 684 {
 685    for (;;) {
 686       if (args) {
 687 #line 271 "lawgen.pcc"
 688        if (comma) pr(", ");
 689
 690 #line 272 "lawgen.pcc"
 691 a_List<Tuple2<Id, Ty> > *
 692 #line 272 "lawgen.pcc"
 693         bvs = boundvars;
 694          Bool found = false;
 695          Bool mode_save = write_mode;
 696          write_mode = false;
 697
 698 #line 287 "lawgen.pcc"
 699          {
 700             for (;;) {
 701                if (bvs) {
 702 #line 278 "lawgen.pcc"
 703                 if (bvs->_1._1 == args->_1)
 704                   {  if (! is_parameter_type(bvs->_1._2))
 705                      { error("%Llaw '%s': type %T cannot be used in parameter %s\n",
 706                              id, bvs->_1._2,bvs->_1._1);
 707                      }
 708                      found = true; pr("%t",bvs->_1._2,bvs->_1._1);
 709                      bvs =
 710 #line 284 "lawgen.pcc"
 711 #line 284 "lawgen.pcc"
 712                   nil_1_
 713 #line 284 "lawgen.pcc"
 714 #line 284 "lawgen.pcc"
 715                   ;
 716                   }
 717                   else bvs = bvs->_2;
 718
 719 #line 287 "lawgen.pcc"
 720                } else { goto L9; }
 721             }
 722             L9:;
 723          }
 724 #line 288 "lawgen.pcc"
 725 #line 288 "lawgen.pcc"
 726
 727          if (! found)
 728             error("%Llaw '%s': bound variable '%s' is absent in body %e\n",
 729                   id, args->_1, exp);
 730          args  = args->_2;
 731          comma = true;
 732          write_mode = mode_save;
 733
 734 #line 295 "lawgen.pcc"
 735       } else { goto L8; }
 736    }
 737    L8:;
 738 }
 739 #line 296 "lawgen.pcc"
 740 #line 296 "lawgen.pcc"
 741
 742
 743     // Generate the body
 744    pr(")%^{ return %e; }\n\n", exp);
 745 }
 746 #line 301 "lawgen.pcc"
 747 /*
 748 ------------------------------- Statistics -------------------------------
 749 Merge matching rules         = yes
 750 Number of DFA nodes merged   = 141
 751 Number of ifs generated      = 20
 752 Number of switches generated = 10
 753 Number of labels             = 7
 754 Number of gotos              = 17
 755 Adaptive matching            = enabled
 756 Fast string matching         = disabled
 757 Inline downcasts             = enabled
 758 --------------------------------------------------------------------------
 759 */