prop-src/matchcom.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file contains the pattern matching compiler of the Prop -> C++
   4 //  translator.  The following methods are implemented:
   5 //
   6 //    (i)   Variable bindings computation of patterns.
   7 //    (ii)  Translation of patterns into decision trees.
   8 //    (iii) Merging, transformation and minimization of decision trees/dags.
   9 //
  10 ///////////////////////////////////////////////////////////////////////////////
  11
  12 #include <string.h>
  13 #include <limits.h>
  14 #include <stdlib.h>
  15 #include <AD/contain/bitset.h>
  16 #include <AD/generic/ordering.h>
  17 #include <AD/strings/quark.h>
  18 #include <AD/strings/charesc.h>
  19 #include "ir.ph"
  20 #include "ast.ph"
  21 #include "matchcom.ph"
  22 #include "patenv.h"
  23 #include "hashtab.h"
  24 #include "config.h"
  25 #include "type.h"
  26 #include "options.h"
  27 #include "list.h"
  28
  29 ///////////////////////////////////////////////////////////////////////////////
  30 //
  31 //  Constructor and destructor for class MatchCompiler
  32 //
  33 ///////////////////////////////////////////////////////////////////////////////
  34 MatchCompiler:: MatchCompiler()
  35    : vars("_X"), labels("L"),
  36      merges(0), ifs(0), switches(0), gotos(0), goto_labels(0),
  37      current_options(MATCHnone), current_rule(0)
  38      {}
  39 MatchCompiler::~MatchCompiler() {}
  40
  41 MatchBase::MatchBase() : shared(0), label(0) {}
  42
  43 HashTable MatchCompiler::quark_map(string_hash,string_equal);
  44 LabelGen MatchCompiler::quark_labels("_Q");
  45
  46 ///////////////////////////////////////////////////////////////////////////////
  47 //
  48 //  Constructor for MatchRuleInfo
  49 //
  50 ///////////////////////////////////////////////////////////////////////////////
  51 MatchRuleInfo::MatchRuleInfo ()
  52   : used(false), ty(NOty), rule_number(0), negated(false), rewriting(false),
  53     is_chain_rule(false), mode(BOTTOMUP), option(NO_OPTIONS) {}
  54
  55 ///////////////////////////////////////////////////////////////////////////////
  56 //
  57 //  Flag that makes all selectors refer to the same object.
  58 //
  59 ///////////////////////////////////////////////////////////////////////////////
  60 Bool same_selectors = false;
  61
  62 ///////////////////////////////////////////////////////////////////////////////
  63 //
  64 //  Allocation routines
  65 //
  66 ///////////////////////////////////////////////////////////////////////////////
  67 Literal * MatchCompiler::Literals(int n)
  68    { return (Literal *)mem_pool[n * sizeof(Literal)]; }
  69 Match   * MatchCompiler::Matches(int n)
  70    { return (Match *)mem_pool[n * sizeof(Match)]; }
  71 static Literal * vec (Literal l)
  72    { Literal * L = (Literal *)mem_pool[sizeof(Literal)];
  73      L[0] = l;
  74      return L;
  75    }
  76 static Match * vec (Match m)
  77    { Match * M = (Match *)mem_pool[sizeof(Match)];
  78      M[0] = m;
  79      return M;
  80    }
  81
  82 ///////////////////////////////////////////////////////////////////////////////
  83 //
  84 //  The mapping from quark name to identifiers
  85 //
  86 ///////////////////////////////////////////////////////////////////////////////
  87 Id MatchCompiler::quark_name(Id id)
  88 {  HashTable::Entry * e = quark_map.lookup(id);
  89    if (e)
  90    {  return (Id)e->v;
  91    } else
  92    {  Id name = Quark(options.mangled_file_name, quark_labels.new_label());
  93       quark_map.insert((HashTable::Key)id,(HashTable::Value)name);
  94       return name;
  95    }
  96 }
  97
  98 ///////////////////////////////////////////////////////////////////////////////
  99 //
 100 //  Reverse the polarity of a pattern.
 101 //
 102 ///////////////////////////////////////////////////////////////////////////////
 103 fun rev ISpositive: Polarity: return ISnegative
 104   | rev ISnegative:           return ISpositive
 105   | rev ISneither:            return ISneither
 106   ;
 107
 108 ///////////////////////////////////////////////////////////////////////////////
 109 //
 110 //  Method to perform substitution on a pattern.
 111 //
 112 ///////////////////////////////////////////////////////////////////////////////
 113 Pat subst(Pat pat, Pat env[], Bool copy)
 114 {  match while (pat)
 115    {  NOpat || WILDpat _ || LEXEMEpat _: { return pat; }
 116    |  IDpat (id,ty,e):         { return IDpat(id,ty,e); }
 117    |  LITERALpat l:            { return LITERALpat(l); }
 118    |  CONSpat c:               { return CONSpat(c); }
 119    |  CONTEXTpat(context,p):   { return CONTEXTpat(context,subst(p,env,copy)); }
 120    |  INDpat  (id,i,t) | copy: { return INDpat(id,i,t); }
 121    |  INDpat  (_,i,_):         { return subst(env[i], env, true); }
 122    |  APPpat  (a,b):           { return APPpat(subst(a,env,copy),subst(b,env,copy)); }
 123    |  TYPEDpat (p,ty):         { return TYPEDpat(subst(p,env,copy),ty); }
 124    |  ASpat    (id,p,ty,e):    { return ASpat(id,subst(p,env,copy),ty,e); }
 125    |  TUPLEpat ps:             { return TUPLEpat(subst(ps,env,copy)); }
 126    |  EXTUPLEpat ps:           { return EXTUPLEpat(subst(ps,env,copy)); }
 127    |  ARRAYpat (ps,flex):      { return ARRAYpat(subst(ps,env,copy),flex); }
 128    |  VECTORpat { cons, elements, len, array, head_flex, tail_flex }:
 129       { return VECTORpat'
 130                { cons      = cons,
 131                  elements  = subst(elements,env,copy),
 132                  len       = subst(len,env,copy),
 133                  array     = subst(array,env,copy),
 134                  head_flex = head_flex,
 135                  tail_flex = tail_flex
 136                };
 137       }
 138    |  RECORDpat (ps,flex):     { return RECORDpat(subst(ps,env,copy),flex); }
 139    |  LISTpat{cons,nil,head,tail}: { return LISTpat'{cons = cons,nil = nil,
 140                                                      head = subst(head,env,copy),
 141                                                      tail = subst(tail,env,copy)
 142                                                      };
 143                                    }
 144    |  LOGICALpat (op,p1,p2):   { return LOGICALpat(op,subst(p1,env,copy),subst(p2,env,copy)); }
 145    |  MARKEDpat (_,p):         { pat = p; }
 146    |  GUARDpat (p,e):          { return GUARDpat(subst(p,env,copy),e); }
 147    |  _:                       { bug("subst()"); }
 148    }
 149 }
 150
 151 ///////////////////////////////////////////////////////////////////////////////
 152 //
 153 //  Method to perform substitution on a pattern list.
 154 //
 155 ///////////////////////////////////////////////////////////////////////////////
 156 Pats subst(Pats pats, Pat env[], Bool copy)
 157 {  match (pats)
 158    { #[]:        { return #[]; }
 159    | #[a ... b]: { return #[ subst(a,env,copy) ... subst(b,env,copy) ]; }
 160    }
 161 }
 162
 163 ///////////////////////////////////////////////////////////////////////////////
 164 //
 165 //  Method to perform substitution on a labeled pattern list.
 166 //
 167 ///////////////////////////////////////////////////////////////////////////////
 168 LabPats subst(LabPats pats, Pat env[], Bool copy)
 169 {  match (pats)
 170    {  #[]:        { return #[]; }
 171    |  #[a ... b]: { LabPat l;
 172                     l.label = a.label;
 173                     l.pat   = subst(a.pat,env,copy);
 174                     return #[ l ... subst(b,env,copy) ];
 175                   }
 176    }
 177 }
 178
 179 ///////////////////////////////////////////////////////////////////////////////
 180 //
 181 //  Pattern application.
 182 //
 183 ///////////////////////////////////////////////////////////////////////////////
 184 Pat apply_pat (Pat scheme, Pat arg)
 185 {  match (scheme) and (arg)
 186    {  POLYpat(_,0,_,pat,_,_), NOpat: { return subst(pat,0,false); }
 187    |  POLYpat(_,1,_,pat,_,_), p:     { return subst(pat,&p,false); }
 188    |  POLYpat(_,n,_,pat,_,_), TUPLEpat ps | length(ps) == n:
 189       {  Pat env[256];
 190          int i = 0;
 191          for_each (Pat, p, ps) env[i++] = p;
 192          return subst(pat,env,false);
 193       }
 194    |  _,  _:
 195       {  error ("%Lunable to apply pattern scheme %p\n"
 196                 "%Lwith argument %p\n", scheme, arg);
 197          return NOpat;
 198       }
 199    }
 200 }
 201
 202 ////////////////////////////////////////////////////////////////////////////////
 203 //
 204 //  Substitution on expressions.
 205 //
 206 ///////////////////////////////////////////////////////////////////////////////
 207 Exp subst (Exp exp, Exp s[])
 208 {  match while (exp)
 209    {  DOTexp(e,l):       { return DOTexp(subst(e,s),l); }
 210    |  RELexp i:          { return s[i]; }
 211    |  SELECTORexp(e,c,t):{ return SELECTORexp(subst(e,s),c,t); }
 212    |  DEREFexp(e):       { return DEREFexp(subst(e,s)); }
 213    |  ARROWexp(e,l):     { return ARROWexp(subst(e,s),l); }
 214    |  INDEXexp(a,b):     { return INDEXexp(subst(a,s), subst(b,s)); }
 215    |  BINOPexp(a,b,c):   { return BINOPexp(a,subst(b,s),subst(c,s)); }
 216    |  PREFIXexp(a,b):    { return PREFIXexp(a,subst(b,s)); }
 217    |  POSTFIXexp(a,b):   { return POSTFIXexp(a,subst(b,s)); }
 218    |  APPexp(a,b):       { return APPexp(subst(a,s), subst(b,s)); }
 219    |  ASSIGNexp(a,b):    { return ASSIGNexp(subst(a,s), subst(b,s)); }
 220    |  IFexp(a,b,c):      { return IFexp(subst(a,s), subst(b,s), subst(c,s)); }
 221    |  TUPLEexp es:       { return TUPLEexp(subst(es,s)); }
 222    |  RECORDexp es:      { return RECORDexp(subst(es,s)); }
 223    |  SENDexp (l,es):    { return SENDexp(l,subst(es,s)); }
 224    |  LISTexp(a,b,es,e): { return LISTexp(a,b,subst(es,s),subst(e,s)); }
 225    |  CONSexp(c,es,e):   { return CONSexp(c,subst(es,s),subst(e,s)); }
 226    |  CASTexp(ty,e):     { return CASTexp(ty,subst(e,s)); }
 227    |  EQexp (ty,a,b):    { return EQexp(ty,subst(a,s),subst(b,s)); }
 228    |  UNIFYexp(ty,a,b):  { return UNIFYexp(ty,subst(a,s),subst(b,s)); }
 229    |  LTexp (ty,a,b):    { return LTexp(ty,subst(a,s),subst(b,s)); }
 230    |  HASHexp (ty,e):    { return HASHexp(ty,subst(e,s)); }
 231    |  SETLexp(op,es):    { return SETLexp(op,subst(es,s)); }
 232    |  MARKEDexp(_,e):    { exp = e; }
 233    |  _:                 { return exp; }
 234    }
 235 }
 236
 237 ///////////////////////////////////////////////////////////////////////////////
 238 //
 239 //  Substitution on expression lists.
 240 //
 241 ///////////////////////////////////////////////////////////////////////////////
 242 Exps subst(Exps es, Exp s[])
 243 {  match (es)
 244    {  #[]:        { return #[]; }
 245    |  #[a ... b]: { return #[ subst(a,s) ... subst(b,s) ]; }
 246    }
 247 }
 248
 249 ///////////////////////////////////////////////////////////////////////////////
 250 //
 251 //  Substitution on labeled expression lists.
 252 //
 253 ///////////////////////////////////////////////////////////////////////////////
 254 LabExps subst(LabExps es, Exp s[])
 255 {  match (es)
 256    {  #[]:        { return #[]; }
 257    |  #[a ... b]: { LabExp e;
 258                     e.label = a.label;
 259                     e.exp   = subst(a.exp,s);
 260                     return #[ e ... subst(b,s) ];
 261                   }
 262    }
 263 }
 264
 265 ///////////////////////////////////////////////////////////////////////////////
 266 //
 267 //  Compute the view selector given the type
 268 //
 269 ///////////////////////////////////////////////////////////////////////////////
 270 Exp view_selector_of(Cons cons, Pat pat, Exp e, Ty ty)
 271 {  Exp selector_exp = default_val(ty);
 272    if (selector_exp == NOexp)
 273    {  error ("%Laccessor is undefined for view pattern: %s %p\n",
 274              (cons != NOcons ? cons->name : "???"), pat);
 275       return NOexp;
 276    } else
 277    {  return subst(selector_exp,&e);
 278    }
 279 }
 280
 281 ///////////////////////////////////////////////////////////////////////////////
 282 //
 283 //  Decorate selector bindings for a view constructor
 284 //
 285 ///////////////////////////////////////////////////////////////////////////////
 286 void decor_view
 287    (Cons cons, Pat pat, Exp sel,
 288     Polarity polarity, Bool visible, PatternVarEnv& E, int& match_rule)
 289 {
 290    if (boxed(pat)) pat->selector = sel; // annotate selector
 291    match (cons)
 292    {  ONEcons { view_selectors, ty ... } | view_selectors != 0:
 293       {  match (arity_of(ty)) and (pat) and (deref ty)
 294          {  0, _, _:  { bug ("decor_view()"); }
 295          |  1, _, _:
 296             { decor(pat,view_selector_of(cons,pat,sel,ty),
 297                     polarity,visible,E,match_rule); }
 298          |  n, TUPLEpat ps, TUPLEty tys:
 299             {  int i;
 300                List<Pat> pat_list;
 301                List<Ty>  ty_list;
 302                for (i = 0, pat_list = ps, ty_list = tys;
 303                     pat_list && ty_list;
 304                     pat_list = pat_list->#2, ty_list = ty_list->#2)
 305                {  decor(pat_list->#1,view_selector_of(cons,pat,sel,ty_list->#1),
 306                         polarity,visible,E,match_rule);
 307                   i++;
 308                }
 309             }
 310          |  n, RECORDpat(ps,_), RECORDty(labs,_,tys):
 311             {  for_each (LabPat, p, ps)
 312                {  int i;
 313                   List<Id> lab_list;
 314                   List<Ty> ty_list;
 315                   for (i = 0, lab_list = labs, ty_list = tys;
 316                        lab_list && ty_list;
 317                        lab_list = lab_list->#2, ty_list = ty_list->#2, i++)
 318                   {  if (lab_list->#1 == p.label)
 319                         decor(p.pat,view_selector_of(cons,pat,sel,ty_list->#1),
 320                               polarity,visible,E,match_rule);
 321                   }
 322                }
 323             }
 324          |  n, _, _:
 325             { error ("%Lbad view constructor pattern: %p", pat); }
 326          }
 327       }
 328    |  ONEcons _:
 329       { error ("%Lmissing view selector for pattern: %p", pat); }
 330    |  _: // skip
 331    }
 332 }
 333
 334 ///////////////////////////////////////////////////////////////////////////////
 335 //
 336 //  Decorate patterns with selector bindings.
 337 //
 338 ///////////////////////////////////////////////////////////////////////////////
 339 void decor
 340    (Pat pat, Exp sel, Polarity polarity, Bool visible, PatternVarEnv& E,
 341     int& match_rule)
 342 {  for(;;) {
 343       if (! boxed(pat)) return;
 344       pat->selector = sel; // annotate selector
 345       match (pat)
 346       {  NOpat || WILDpat _ || LITERALpat _ || CONSpat _: { return; }
 347       |  LEXEMEpat (_, ty, n, conses) | conses:
 348             // generate lexeme pattern binding
 349          {  if (visible)
 350             {  Ty t = NOty;
 351                Exp binding =
 352                   CASTexp(ty, BINOPexp("+",IDexp("rule__"),
 353                           LITERALexp(INTlit(conses[0]->tag + 256 - 1 - match_rule))));
 354                E.add(#"?lexeme", binding, t, polarity);
 355                match_rule += n - 1;
 356             }
 357             return;
 358          }
 359       |  LEXEMEpat _: { return; } // skip
 360       |  IDpat (id,ty,e):  // generate pattern variable binding
 361          {  if (visible)
 362             {  Exp exp = E.add(id,sel,ty,polarity);
 363                if (E.separate_guard() && ! E.tree_grammar() && exp != NOexp)
 364                   E.add_guard(EQexp(ty,sel,exp));
 365                else
 366                   e = exp;
 367             }
 368             return;
 369          }
 370       |  ASpat (id,p,ty,e): // generate pattern variable alias binding
 371          {  if (visible)
 372             {  Exp exp = E.add(id,sel,ty,polarity);
 373                if (E.separate_guard() && ! E.tree_grammar() && exp != NOexp)
 374                   E.add_guard(EQexp(ty,sel,exp));
 375                else
 376                   e = exp;
 377             }
 378             pat = p;
 379          }
 380       |  MARKEDpat(_,p):   { pat = p; }
 381       |  UNIFYpat(p,_):    { pat = p; }
 382       |  CONTEXTpat(_,p):  { pat = p; }
 383       |  TYPEDpat(p,_):    { pat = p; }
 384       |  GUARDpat(p,e):    { pat = p; }
 385       |  TUPLEpat (ps):
 386          {  int i = 1;
 387             for_each (Pat,p,ps)
 388             {  decor(p,DOTexp(sel,index_of(i)),polarity,visible,E,match_rule);
 389                i++;
 390             }
 391             return;
 392          }
 393       |  EXTUPLEpat (ps):
 394          {  int i = 1;
 395             for_each (Pat,p,ps)
 396             {  decor(p,DOTexp(sel,index_of(i)),polarity,visible,E,match_rule);
 397                i++;
 398             }
 399             return;
 400          }
 401       |  ARRAYpat (ps,_):
 402          {  int i = 0;
 403             for_each (Pat,p,ps)
 404             {  decor(p,INDEXexp(sel,LITERALexp(INTlit(i))),polarity,visible,E,
 405                      match_rule);
 406                i++;
 407             }
 408             return;
 409          }
 410       |  VECTORpat { cons, elements, array, len, head_flex, tail_flex ... }:
 411          {  int i       = 0;
 412             Exp s       = select(sel,cons);
 413             Exp len_exp = DOTexp(s,"len()");
 414             int n       = length(elements);
 415             for_each (Pat,p,elements)
 416             {  Exp index_exp =
 417                  head_flex ? BINOPexp("-",len_exp,LITERALexp(INTlit(n-i)))
 418                            : LITERALexp(INTlit(i));
 419                decor(p,APPexp(DOTexp(s,"at"),index_exp),polarity,visible,E,
 420                      match_rule);
 421                i++;
 422             }
 423             decor(len,len_exp,polarity,visible,E,match_rule);
 424             decor(array,DOTexp(s,"array()"),polarity,visible,E,match_rule);
 425             return;
 426          }
 427       |  RECORDpat (ps,_):
 428          {  for_each (LabPat,lab_pat,ps)
 429                decor(lab_pat.pat, DOTexp(sel,lab_pat.label),
 430                      polarity, visible, E, match_rule);
 431             return;
 432          }
 433       |  APPpat(CONSpat(c as ONEcons {
 434                    alg_ty = DATATYPEty({ qualifiers ...},_) ...}),
 435                 p) | qualifiers & QUALview:
 436          {  decor_view (c,p,sel,polarity,visible,E,match_rule); return; }
 437       |  APPpat(CONSpat(cons),p):
 438          {  decor(p,select(sel,cons),polarity,visible,E,match_rule); return; }
 439       |  LOGICALpat(NOTpat,p,_): { polarity = rev(polarity); pat = p; }
 440       |  LOGICALpat(ANDpat,a,b):
 441          { decor(a,sel,polarity,visible,E,match_rule); pat = b; }
 442       |  LOGICALpat(ORpat,a,b):  { decor(a,sel,polarity,false,E,match_rule);
 443                                    pat = b; visible = false;
 444                                  }
 445       |  LOGICALpat(EQUIVpat || XORpat || IMPLIESpat,a,b):
 446          {  decor(a,sel,ISneither,false,E,match_rule);
 447             pat = b; visible = false; polarity = ISneither;
 448          }
 449       |  LISTpat{cons, nil, head = ps, tail = p}:
 450          {  for_each (Pat, apat, ps)
 451             {  decor(apat,DOTexp(select(sel,cons),"_1"),polarity,visible,
 452                      E,match_rule);
 453                sel = DOTexp(select(sel,cons),"_2");
 454             }
 455             pat = p;
 456          }
 457       |  _:  { bug("decor()"); }
 458       }
 459    }
 460 }
 461
 462 ///////////////////////////////////////////////////////////////////////////////
 463 //
 464 //  Decorate a pattern list with bindings.
 465 //
 466 ///////////////////////////////////////////////////////////////////////////////
 467 void decor
 468    (MatchExps exps, Pat pat, Polarity polarity, Bool visible,
 469     PatternVarEnv& E, int& match_rule)
 470 {
 471    int arity = length(exps);
 472    if (arity == 1) {
 473       match (exps->#1)
 474       {  MATCHexp(e,mv):
 475          {  decor(pat,mv ? IDexp(mv) : e, polarity, visible, E, match_rule); }
 476       }
 477    } else {
 478       match (pat)
 479       {  WILDpat _:       { /* skip */ }
 480       |  MARKEDpat(_,p):  { decor(exps,p,polarity,visible,E,match_rule); }
 481       |  CONTEXTpat(_,p): { decor(exps,p,polarity,visible,E,match_rule); }
 482       |  TUPLEpat pats | length(pats) == arity:
 483          {  Pats      ps;
 484             MatchExps es;
 485             for (ps = pats, es = exps; ps; ps = ps->#2, es = es->#2)
 486             {  match (es->#1)
 487                {  MATCHexp(e,mv):
 488                   { decor(ps->#1,mv ? IDexp(mv) : e, polarity,
 489                           visible, E, match_rule);
 490                   }
 491                }
 492             }
 493          }
 494       |  LOGICALpat(NOTpat,p,_):
 495          {  decor(exps,p,rev(polarity),false,E,match_rule); }
 496       |  LOGICALpat(ANDpat,a,b):
 497          {  decor(exps,a,polarity,visible,E,match_rule);
 498             decor(exps,b,polarity,visible,E,match_rule);
 499          }
 500       |  LOGICALpat(ORpat,a,b):
 501          {  decor(exps,a,polarity,false,E,match_rule);
 502             decor(exps,b,polarity,false,E,match_rule);
 503          }
 504       |  LOGICALpat(_,a,b):
 505          {  decor(exps,a,ISneither,false,E,match_rule);
 506             decor(exps,b,ISneither,false,E,match_rule);
 507          }
 508       |  _: { error ("%Larity mismatch (expecting %i) in pattern: %p\n",
 509                      arity, pat); }
 510       }
 511    }
 512 }
 513
 514 ///////////////////////////////////////////////////////////////////////////////
 515 //
 516 //  Return the arity of a pattern
 517 //
 518 ///////////////////////////////////////////////////////////////////////////////
 519 fun arity_of TUPLEpat  ps: int:           return length(ps)
 520   | arity_of RECORDpat (l,flex) | ! flex: return length(l)
 521   | arity_of MARKEDpat(_,p):              return arity_of(p)
 522   | arity_of LOGICALpat(NOTpat,p,_):      return arity_of(p)
 523   | arity_of CONTEXTpat(_,p):             return arity_of(p)
 524   | arity_of p as LOGICALpat(_,a,b):
 525      {  int i = arity_of(a);
 526         int j = arity_of(b);
 527         if (i != j) error ("%Larity mismatch in logical pattern: %p\n",p);
 528         return i;
 529      }
 530   | arity_of p as RECORDpat _:
 531      { error ("%Lillegal incomplete record pattern: %p\n",p); return 0; }
 532   | arity_of _:                           { return 1; }
 533   ;
 534
 535 ///////////////////////////////////////////////////////////////////////////////
 536 //
 537 //  Make a list of match expressions
 538 //
 539 ///////////////////////////////////////////////////////////////////////////////
 540 MatchExps make_match_exps(int i, int n, int j)
 541 {  if (i > n) return #[];
 542    else {
 543       Exp e = j < 0 ? IDexp(index_of(i,"x")) : RELexp(j);
 544       return #[ MATCHexp(e, #[]) ... make_match_exps(i+1,n,j) ];
 545    }
 546 }
 547
 548 ///////////////////////////////////////////////////////////////////////////////
 549 //
 550 //  Main decoration routine
 551 //
 552 ///////////////////////////////////////////////////////////////////////////////
 553 void decor(MatchExps& exps, Pat pat, PatternVarEnv& E, int& match_rule, int i)
 554 {  if (exps == #[])  // create default match expressions if there are none
 555       exps = make_match_exps(1,arity_of(pat), i);
 556    decor(exps,pat,ISpositive,true,E,match_rule);
 557 }
 558
 559 ///////////////////////////////////////////////////////////////////////////////
 560 //
 561 //  Translate a string literal into a character array pattern.
 562 //
 563 ///////////////////////////////////////////////////////////////////////////////
 564 List<Pat> make_string_pattern (const char * string)
 565 {  if (string[0] == '\"' && string[1] == '\0') {
 566       return #[ LITERALpat(CHARlit('\0')) ];
 567    } else {
 568       char c;
 569       const char * next_pos = parse_char(string,c);
 570       List<Pat> pats        = make_string_pattern(next_pos);
 571       return #[ LITERALpat(CHARlit(c)) ... pats ];
 572    }
 573 }
 574
 575 ///////////////////////////////////////////////////////////////////////////////
 576 //
 577 //  Translate a pattern into a matching tree.
 578 //
 579 ///////////////////////////////////////////////////////////////////////////////
 580 Match MatchCompiler::trans(Pat pat, Pos pos, Bool neg, Match yes, Match no)
 581 {  match while (pat)
 582    {  NOpat || WILDpat _ || IDpat(_,_,NOexp): { return neg ? no : yes; }
 583    |  ASpat(_,p,_,NOexp):      { pat = p; }
 584    |  TYPEDpat(p,_):           { pat = p; }
 585    |  MARKEDpat(_,p):          { pat = p; }
 586    |  CONTEXTpat(c,p):         { pat = add_contexts(c,p); }
 587    |  LEXEMEpat(_, ty, n, cs): { pat = expand_lexeme_pat(pat,ty,n,cs); }
 588    |  IDpat (_,ty,e):
 589       {  return GUARDmatch(EQexp(ty,pat->selector,e),
 590                    neg ? no : yes, neg ? yes : no); }
 591    |  GUARDpat (p,e):
 592       {  Match m = trans(p,pos,neg,yes,no);
 593          return GUARDmatch(e, neg ? no : m, neg ? m : no);
 594       }
 595    |  ASpat(_,p,ty,e):
 596       {  Exp guard = EQexp(ty,pat->selector,e);
 597          if (neg) no  = GUARDmatch(guard,no,yes);
 598          else     yes = GUARDmatch(guard,yes,no);
 599          pat = p;
 600       }
 601    |  LITERALpat l:
 602       { return LITERALmatch(pos,pat->selector,vec(l),1,vec(neg ? no : yes),
 603                             neg ? yes : no);
 604       }
 605    |  TUPLEpat ps:
 606       {  if (current_index_map) {
 607             HashTable::Entry * e = current_index_map->lookup(pos);
 608             if (e)
 609                return trans(ps,pos,neg,yes,no,
 610                             (int *)current_index_map->value(e));
 611          }
 612          return trans(ps,0,pos,neg,yes,no);
 613       }
 614    |  EXTUPLEpat ps:
 615       {  if (current_index_map) {
 616             HashTable::Entry * e = current_index_map->lookup(pos);
 617             if (e)
 618                return trans(ps,pos,neg,yes,no,
 619                             (int *)current_index_map->value(e));
 620          }
 621          return trans(ps,0,pos,neg,yes,no);
 622       }
 623    |  ARRAYpat (ps,_):     { return trans(ps,0,pos,neg,yes,no); }
 624    |  VECTORpat{ elements, len, array, head_flex, tail_flex ... }:
 625       {  int low   = length(elements);
 626          int high  = (head_flex || tail_flex) ? INT_MAX : low;
 627          int start = head_flex ? (INT_MAX - length(elements)) : 0;
 628          Match p1 = trans(elements,start,pos,neg,yes,no);
 629          Match p2 = trans(array,pos,neg,(neg ? no : p1),(neg ? p1 : no));
 630          Match p3 = trans(len,pos,neg,(neg ? no : p2),(neg ? p3 : no));
 631          return RANGEmatch(pos,ARROWexp(pat->selector,"len()"),low,high,
 632                            (neg ? no : p3), (neg ? p3 : no));
 633       }
 634    |  RECORDpat (ps,flex): { return trans(ps,pos,neg,yes,no); }
 635    |  APPpat(CONSpat(ONEcons {
 636                 alg_ty = alg_ty as DATATYPEty({ unit, arg ... },_),
 637                 tag
 638                 ...
 639               }), pattern_argument):
 640       {  int arity = unit + arg;
 641          Match * m = Matches(arity);
 642          int i;
 643          for (i = arity - 1; i >= 0; i--) m[i] = neg ? yes : no;
 644          i = tag + unit;
 645          m[i] = trans(pattern_argument,POSint(i,pos),neg,yes,no);
 646          return CONSmatch(pos,pat->selector,pat->ty,alg_ty,arity,m,neg ? yes : no);
 647       }
 648    |  CONSpat(ONEcons {
 649                  tag,
 650                  alg_ty = alg_ty as DATATYPEty({ unit, arg ... },_)
 651                  ... }):
 652       {  int arity = unit + arg;
 653          Match * m = Matches(arity);
 654          for (int i = arity - 1; i >= 0; i--) m[i] = neg ? yes : no;
 655          m[tag] = neg ? no : yes;
 656          return CONSmatch(pos,pat->selector,pat->ty,alg_ty,arity,m,neg ? yes : no);
 657       }
 658    |  LOGICALpat(NOTpat,p,_):
 659       { return trans(p, pos,! neg, yes, no); }
 660    |  LOGICALpat(ANDpat,a,b):
 661       { return neg ? merge(trans(a,pos,neg,yes,no),trans(b,pos,neg,yes,no))
 662                    : trans(a, pos, neg, trans(b, pos, neg, yes, no), no);
 663       }
 664    |  LOGICALpat(ORpat,a,b):
 665       { return neg ? trans(a, pos, neg, trans(b, pos, neg, yes, no), no)
 666                    : merge(trans(a,pos,neg,yes,no),trans(b,pos,neg,yes,no));
 667       }
 668    |  LOGICALpat(IMPLIESpat,a,b): // a -> b   <=>  ! a \/ b
 669       { pat = LOGICALpat(ORpat, LOGICALpat(NOTpat,a,NOpat), b); }
 670    |  LOGICALpat(EQUIVpat,a,b):   // a <-> b  <=>  (a /\ b) \/ (! a /\ ! b)
 671       { pat = LOGICALpat(ORpat,
 672                  LOGICALpat(ANDpat, a, b),
 673                  LOGICALpat(ANDpat, LOGICALpat(NOTpat,a,NOpat),
 674                                     LOGICALpat(NOTpat,b,NOpat)));
 675       }
 676    |  LOGICALpat(XORpat,a,b):    // a xor b <=> (a /\ ! b) \/ (! a /\ b)
 677       { pat = LOGICALpat(ORpat,
 678                  LOGICALpat(ANDpat, a, LOGICALpat(NOTpat,b,NOpat)),
 679                  LOGICALpat(ANDpat, LOGICALpat(NOTpat,a,NOpat), b));
 680       }
 681    |  LISTpat{cons, nil, head = #[], tail = NOpat}:
 682       {  Pat p = CONSpat(nil); p->selector = pat->selector; pat = p; }
 683    |  LISTpat{cons, nil, head = #[], tail }: { pat = tail; }
 684    |  LISTpat{cons, nil, head = #[h ... t], tail}:
 685       {  Pat new_tail   = LISTpat'{cons=cons,nil=nil,head=t,tail=tail};
 686          Pat list_pat   = APPpat(CONSpat(cons),TUPLEpat(#[h, new_tail]));
 687          new_tail->selector = DOTexp(select(pat->selector,cons),"_2");
 688          list_pat->selector = pat->selector;
 689          pat = list_pat;
 690       }
 691       // skip all these cases (error is already caught elsewhere)
 692    |  CONSpat NOcons ||
 693       APPpat (CONSpat NOcons, _) ||
 694       LISTpat { cons = NOcons ... } ||
 695       LISTpat { nil = NOcons ... }:
 696          { return neg ? no : yes; }
 697    |  _: { bug("MatchCompiler::trans(): %p", pat); }
 698    }
 699 }
 700
 701 ///////////////////////////////////////////////////////////////////////////////
 702 //
 703 //  Translate a pattern list into a matching tree using ranking function.
 704 //
 705 ///////////////////////////////////////////////////////////////////////////////
 706 Match MatchCompiler::trans
 707    (Pats ps, Pos pos, Bool neg, Match yes, Match no, int rank[])
 708 {  Pat Ps[256];
 709    int i = 0;
 710    for_each (Pat, p, ps) Ps[i++] = p;
 711    int n = i;
 712    Match m = yes;
 713    for (i = n - 1; i >= 0; i--)
 714       m = trans(Ps[rank[i]], POSint(i, pos), neg, m, no);
 715    return m;
 716 }
 717
 718 ///////////////////////////////////////////////////////////////////////////////
 719 //
 720 //  Translate a pattern list into a matching tree.
 721 //
 722 ///////////////////////////////////////////////////////////////////////////////
 723 Match MatchCompiler::trans
 724    (Pats ps, int i, Pos pos, Bool neg, Match yes, Match no)
 725 {  match (ps)
 726    {  #[]:        { return yes; }
 727    |  #[a ... b]: { return trans(a, POSint(i, pos), neg,
 728                               trans(b, i+1, pos, neg, yes, no), no);
 729                   }
 730    }
 731 }
 732
 733 ///////////////////////////////////////////////////////////////////////////////
 734 //
 735 //  Translate a labeled pattern list into a matching tree.
 736 //
 737 ///////////////////////////////////////////////////////////////////////////////
 738 Match MatchCompiler::trans
 739    (LabPats ps, Pos pos, Bool neg, Match yes, Match no)
 740 {  match (ps)
 741    {  #[]:        { return yes; }
 742    |  #[a ... b]: { return trans(a.pat, POSlabel(a.label, pos), neg,
 743                               trans(b, pos, neg, yes, no), no);
 744                   }
 745    }
 746 }
 747
 748 ///////////////////////////////////////////////////////////////////////////////
 749 //
 750 //  Get the position list of a matching tree node.
 751 //
 752 ///////////////////////////////////////////////////////////////////////////////
 753 fun get_pos LITERALmatch(pos,_,_,_,_,_): Pos:   { return pos; }
 754   | get_pos RANGEmatch  (pos,_,_,_,_,_):        { return pos; }
 755   | get_pos CONSmatch   (pos,_,_,_,_,_,_):      { return pos; }
 756   | get_pos SUCCESSmatch _ || SUCCESSESmatch _ || COSTmatch _:
 757                                                 { return POSinfinity; }
 758   | get_pos _:                                  { return POSzero; }
 759   ;
 760
 761 ///////////////////////////////////////////////////////////////////////////////
 762 //
 763 //  Position list comparison result.
 764 //
 765 ///////////////////////////////////////////////////////////////////////////////
 766 datatype CompareResult = LESS | SAME | MORE | NEITHER;
 767
 768 ///////////////////////////////////////////////////////////////////////////////
 769 //
 770 //  Compare two position lists lexicographically.
 771 //
 772 ///////////////////////////////////////////////////////////////////////////////
 773 CompareResult compare_pos(Pos a, Pos b)
 774 {  Pos u, v;
 775    match (a) and (b)
 776    {  a,                  b | a == b:         { return SAME; }
 777    |  POSzero,            _:                  { return LESS; }
 778    |  _,                  POSzero:            { return MORE; }
 779    |  POSinfinity,        _:                  { return MORE; }
 780    |  _,                  POSinfinity:        { return LESS; }
 781    |  POSint(_,x),        POSlabel(_,y):      { u = x; v = y; }
 782    |  POSint(_,x),        POSadaptive(_,_,y): { u = x; v = y; }
 783    |  POSlabel(_,x),      POSint(_,y):        { u = x; v = y; }
 784    |  POSlabel(_,x),      POSadaptive(_,_,y): { u = x; v = y; }
 785    |  POSadaptive(_,_,y), POSint(_,x):        { u = x; v = y; }
 786    |  POSadaptive(_,_,y), POSlabel(_,x):      { u = x; v = y; }
 787    |  POSint(i,x),        POSint(j,y):
 788       {  CompareResult r = compare_pos(x,y);
 789          if (r != SAME) return r;
 790          if (i == j) return SAME;
 791          if (i <  j)  return LESS;
 792          return MORE;
 793       }
 794    |  POSlabel(i,x),      POSlabel(j,y):
 795       {  CompareResult r = compare_pos(x,y);
 796          if (r != SAME) return r;
 797          int s = strcmp(i,j);
 798          if (s == 0) return SAME;
 799          if (s < 0)  return LESS;
 800          return MORE;
 801       }
 802    |  POSadaptive(i,rank1,x), POSadaptive(j,rank2,y):
 803       {  CompareResult r = compare_pos(x,y);
 804          if (r != SAME) return r;
 805          if (rank1[i] == rank2[j]) return SAME;
 806          if (rank1[i] <  rank2[j]) return LESS;
 807          return MORE;
 808       }
 809    }
 810
 811    CompareResult r = compare_pos(u,v);
 812    if (r != SAME) return r;
 813    return NEITHER;
 814 }
 815
 816 ///////////////////////////////////////////////////////////////////////////////
 817 //
 818 //  Compare two position lists lexicographically.
 819 //
 820 ///////////////////////////////////////////////////////////////////////////////
 821 Bool pos_equal(HashTable::Key p, HashTable::Key q)
 822 {  return compare_pos((Pos)p, (Pos)q) == SAME; }
 823
 824 ///////////////////////////////////////////////////////////////////////////////
 825 //
 826 //  Compare two literals.
 827 //
 828 ///////////////////////////////////////////////////////////////////////////////
 829 fun compare_literals INTlit i,    INTlit j:int:{ return i - j; }
 830   | compare_literals REALlit x,   REALlit y:   { return x < y ? -1 : (x > y ? 1 : 0); }
 831   | compare_literals CHARlit c,   CHARlit d:   { return (int)c - (int)d; }
 832   | compare_literals BOOLlit b,   BOOLlit c:   { return b - c; }
 833   | compare_literals STRINGlit s, STRINGlit t: { return strcmp(s,t); }
 834   | compare_literals REGEXPlit s, REGEXPlit t: { return strcmp(s,t); }
 835   | compare_literals QUARKlit  s, QUARKlit  t: { return strcmp(s,t); }
 836   | compare_literals BIGINTlit s, BIGINTlit t: { return strcmp(s,t); }
 837   | compare_literals _,           _:           { return 1; }
 838   ;
 839
 840 ///////////////////////////////////////////////////////////////////////////////
 841 //
 842 //  Compare two expressions.
 843 //
 844 ///////////////////////////////////////////////////////////////////////////////
 845 Bool equal (Exp a, Exp b)
 846 {  match while (a) and (b)
 847    {  a,               b | a == b:     { return true; }
 848    |  LITERALexp x,    LITERALexp y:   { return compare_literals(x,y)==0; }
 849    |  IDexp      x,    IDexp      y:   { return x == y; }
 850    |  RELexp     i,    RELexp     j:   { return same_selectors || i == j; }
 851    |  DOTexp (a,x),    DOTexp (b,y):   { return x == y && equal(a,b); }
 852    |  SELECTORexp(a,x,u),SELECTORexp(b,y,v):
 853                                        { return x == y && equal(a,b); }
 854    |  DEREFexp   x,    DEREFexp   y:   { return equal(x,y); }
 855    |  ARROWexp(a,x),   ARROWexp(b,y):  { return x == y && equal(a,b); }
 856    |  INDEXexp(a,i),   INDEXexp(b,j):  { return equal(a,b) && equal(i,j); }
 857    |  BINOPexp(a,b,c), BINOPexp(d,e,f):
 858       { return strcmp(a,d) == 0 && equal(b,e) && equal(c,f); }
 859    |  PREFIXexp(a,b),  PREFIXexp(c,d):  { return !strcmp(a,c) && equal(b,d);}
 860    |  POSTFIXexp(a,b), POSTFIXexp(c,d): { return !strcmp(a,c) && equal(b,d);}
 861    |  APPexp(a,b),     APPexp(c,d):     { return equal(a,c) && equal(b,d); }
 862    |  ASSIGNexp(a,b),  ASSIGNexp(c,d):  { return equal(a,c) && equal(b,d); }
 863    |  IFexp(a,b,c),    IFexp(d,e,f):
 864       { return equal(a,d) && equal(b,e) && equal(c,f); }
 865    |  TUPLEexp a,      TUPLEexp b:      { return equal(a,b); }
 866    |  RECORDexp a,     RECORDexp b:     { return equal(a,b); }
 867    |  SENDexp(a,b),    SENDexp(c,d):    { return a == c && equal(b,d); }
 868    |  LISTexp(a,_,b,c), LISTexp(d,_,e,f):
 869       { return a == d && equal(b,e) && equal(c,f); }
 870    |  CONSexp(a,b,c),  CONSexp(d,e,f):  { return a == d && equal(b,e) && equal(c,f); }
 871    |  EQexp(_,a,b),    EQexp(_,c,d):    { return equal(a,c) && equal(b,d); }
 872    |  UNIFYexp(_,a,b), UNIFYexp(_,c,d): { return equal(a,c) && equal(b,d); }
 873    |  LTexp(_,a,b),    LTexp(_,c,d):    { return equal(a,c) && equal(b,d); }
 874    |  HASHexp(_,x),    HASHexp(_,y):    { a = x; b = y; }
 875    |  THISCOSTexp _,   THISCOSTexp _:   { return true; }
 876    |  COSTexp i,       COSTexp j:       { return i == j; }
 877    |  SYNexp(a,b,_,_), SYNexp(c,d,_,_):   { return a == c && b == d; }
 878    |  THISSYNexp(i,_,_), THISSYNexp(j,_,_): { return i == j; }
 879    |  MARKEDexp(_,x),  _:               { a = x; }
 880    |  _,               MARKEDexp(_,y):  { b = y; }
 881    |  _,               _:               { return false; }
 882    }
 883 }
 884
 885 ///////////////////////////////////////////////////////////////////////////////
 886 //
 887 //  Equality between two expression lists
 888 //
 889 ///////////////////////////////////////////////////////////////////////////////
 890 Bool equal (Exps a, Exps b)
 891 {  match while (a) and (b)
 892    {   #[u ... v],  #[w ... x]:
 893        { if (! equal(u, w)) return false; a = v; b = x; }
 894    }
 895    return a == #[] && b == #[];
 896 }
 897
 898 ///////////////////////////////////////////////////////////////////////////////
 899 //
 900 //  Equality between two labeled expression lists
 901 //
 902 ///////////////////////////////////////////////////////////////////////////////
 903 Bool equal (LabExps a, LabExps b)
 904 {  match while (a) and (b)
 905    {  #[u ... v],  #[w ... x]:
 906       {  if (! equal(u.exp, w.exp)) return false; a = v; b = x; }
 907    }
 908    return a == #[] && b == #[];
 909 }
 910
 911 ///////////////////////////////////////////////////////////////////////////////
 912 //
 913 //  Check to see if we have a regular expression.
 914 //
 915 ///////////////////////////////////////////////////////////////////////////////
 916 Bool has_regexp(int n, Literal l[])
 917 {  for (int i = n - 1; i >= 0; i--)
 918    {  match (l[i]) { REGEXPlit _: { return true; } | _: { /* skip */ } } }
 919    return false;
 920 }
 921
 922 ///////////////////////////////////////////////////////////////////////////////
 923 //
 924 //  Convert all string literals into regular expression literals.
 925 //
 926 ///////////////////////////////////////////////////////////////////////////////
 927 void convert_regexp(int n, Literal l[])
 928 {  for (int i = n-1; i >= 0; i--)
 929    {  match (l[i])
 930       {  STRINGlit s: { l[i] = REGEXPlit(convert_regexp(s)); }
 931       |  _:           { /* skip */ }
 932       }
 933    }
 934 }
 935
 936 ///////////////////////////////////////////////////////////////////////////////
 937 //
 938 //  Compose two matching trees.
 939 //
 940 ///////////////////////////////////////////////////////////////////////////////
 941 Match MatchCompiler::compose (Match a, Match b)
 942 {  match (a) and (b)
 943    {  SUCCESSESmatch (n,a,rules), SUCCESSESmatch (_,b,_):
 944       {  BitSet * c = new (mem_pool, n) BitSet;
 945          c->Union(*a,*b);
 946          return SUCCESSESmatch(n,c,rules);
 947       }
 948       // Cost minimization
 949    |  COSTmatch (n, costs, set1, rules), COSTmatch (_, _, set2, _):
 950       {  register BitSet * set = new (mem_pool, n) BitSet;
 951          set->Union (*set1, *set2);
 952          register int min_cost = MAX_COST;
 953          register int r;
 954
 955          // Find the minimal known cost
 956          for (r = 0; r < n; r++) {
 957             if (set->contains(r)) {
 958                match (costs[r])
 959                {  NOcost:                   { min_cost = 0; }
 960                |  INTcost c | c < min_cost: { min_cost = c; }
 961                |  _:
 962                }
 963             }
 964          }
 965
 966          // Prune away all the rules with higher or equal cost than min_cost.
 967          Bool found = false;
 968          for (r = 0; r < n; r++) {
 969             if (set->contains(r)) {
 970                match (costs[r])
 971                {  NOcost:    { if (! found) set->remove(r); found = true; }
 972                |  INTcost c: { if (c > min_cost || found) set->remove(r);
 973                                found = true; }
 974                |  _: // skip
 975                }
 976             }
 977          }
 978
 979          return COSTmatch (n, costs, set, rules);
 980       }
 981    |  _: { /* skip */ }
 982    }
 983
 984    match (a)
 985    {  FAILmatch:                        { return b; }
 986    |  DONTCAREmatch:                    { return a; }
 987    |  BACKEDGEmatch _:                  { return a; }
 988    |  SUCCESSmatch _:                   { return a; }
 989    |  SUCCESSESmatch _ || COSTmatch _:  { return compose(b,a); }
 990    |  GUARDmatch (e,y,n): { return GUARDmatch(e,merge(y,b),merge(n,b)); }
 991    |  LITERALmatch (p,e,l,n,m,d):
 992       {  Match * br = Matches(n);
 993          for (int i = n - 1; i >= 0; i--) br[i] = merge(m[i],b);
 994          return LITERALmatch(p,e,l,n,br,merge(d,b));
 995       }
 996    |  CONSmatch (p,e,c,c',n,m,d):
 997       {  Match * br = Matches(n);
 998          for (int i = n - 1; i >= 0; i--) br[i] = merge(m[i],b);
 999          return CONSmatch(p,e,c,c',n,br,merge(d,b));
1000       }
1001    |  RANGEmatch (p,e,lo,hi,y,n):
1002       {  return RANGEmatch(p,e,lo,hi,merge(y,b),merge(n,b)); }
1003    |  TREECOSTmatch _ || TREELABELmatch _:
1004       {  bug("MatchCompiler::compose: %m, %m",a,b); return a; }
1005    }
1006 }
1007
1008 ///////////////////////////////////////////////////////////////////////////////
1009 //
1010 //  Merge two matching trees.
1011 //
1012 ///////////////////////////////////////////////////////////////////////////////
1013 Match MatchCompiler::merge (Match a, Match b)
1014 {  match (a) and (b)
1015    {  FAILmatch,         _:           { return b; }
1016    |  _,                 FAILmatch:   { return a; }
1017    |  SUCCESSmatch _,    _:           { return a; }
1018    |  (_,                SUCCESSmatch _  ) ||
1019       (SUCCESSESmatch _, _               ) ||
1020       (_,                SUCCESSESmatch _) ||
1021       (COSTmatch _,      _               ) ||
1022       (_,                COSTmatch _     ): { return compose(a,b); }
1023    |  _,                _:                  // skip
1024    }
1025
1026    match (compare_pos(get_pos(a),get_pos(b))) and (a) and (b)
1027    {  SAME, GUARDmatch(e1,yes1,no1), GUARDmatch(e2,yes2,no2):
1028       { if (equal(e1,e2))
1029             return GUARDmatch(e1,merge(yes1,yes2), merge(no1,no2));
1030         else return GUARDmatch(e1,merge(yes1,b),merge(no1,b));
1031       }
1032    |  SAME, RANGEmatch(p,e1,lo1,hi1,y1,n1), RANGEmatch(_,e2,lo2,hi2,y2,n2):
1033       {  if (lo1 == 0 && hi1 == INT_MAX)
1034             return merge(y1,b);
1035          else if (lo1 <= lo2 && hi1 >= hi2)
1036             return RANGEmatch(p,e1,lo1,hi1,merge(y1,y2),merge(n1,n2));
1037          else
1038             return RANGEmatch(p,e2,lo1,hi1,merge(y1,b),merge(n1,b));
1039       }
1040    |  SAME, LITERALmatch(p,e1,l1,n1,m1,d1), LITERALmatch(_,e2,l2,n2,m2,d2):
1041       {  int i, n = n1 + n2;
1042          Match   * br = Matches(n);
1043          Literal * ls = Literals(n);
1044
1045          if (has_regexp(n1,l1) || has_regexp(n2,l2)) {
1046             for (i = 0; i < n1; i++) { br[i] = m1[i]; ls[i] = l1[i]; }
1047             for (i = 0; i < n2; i++) { br[n1+i] = m2[i]; ls[n1+i] = l2[i]; }
1048             convert_regexp(n,ls);
1049          } else {
1050             // merge and eliminate duplicates
1051             int i, j, k;
1052             for (i = 0, j = 0, k = 0; i < n1 && j < n2; )
1053             {  int dir = compare_literals(l1[i],l2[j]);
1054                if (dir == 0)
1055                   { ls[k] = l1[i]; br[k] = merge(m1[i],m2[j]); i++; j++; }
1056                else if (dir < 0)
1057                   { ls[k] = l1[i]; br[k] = merge(m1[i],d2); i++; }
1058                else
1059                   { ls[k] = l2[j]; br[k] = merge(d1,m2[j]); j++; }
1060                k++;
1061             }
1062             while (i < n1) { ls[k] = l1[i]; br[k++] = merge(m1[i++],d2); }
1063             while (j < n2) { ls[k] = l2[j]; br[k++] = merge(d1,m2[j++]); }
1064             n = k;
1065          }
1066          return LITERALmatch(p,e1,ls,n,br,merge(d1,d2));
1067       }
1068    |  SAME, CONSmatch (p,e1,c,c',n,m1,d1), CONSmatch(_,_,_,_,_,m2,d2):
1069       {  Match * br = Matches(n);
1070          for (int i = n - 1; i >= 0; i--) br[i] = merge(m1[i],m2[i]);
1071          return CONSmatch (p,e1,c,c',n,br,merge(d1,d2));
1072       }
1073    |  LESS, GUARDmatch(e,yes,no), _:
1074       {  return GUARDmatch(e, merge(yes,b), merge(no,b)); }
1075    |  LESS, LITERALmatch(p,e,l,n,m,d), _:
1076       {  Match * br = Matches(n);
1077          for (int i = n - 1; i >= 0; i--) br[i] = merge(m[i],b);
1078          return LITERALmatch(p,e,l,n,br,merge(d,b));
1079       }
1080    |  LESS, CONSmatch(p,e,c,c',n,m,d), _:
1081       {  Match * br = Matches(n);
1082          for (int i = n - 1; i >= 0; i--) br[i] = merge(m[i],b);
1083          return CONSmatch (p,e,c,c',n,br,merge(d,b));
1084       }
1085    |  MORE, _, GUARDmatch(e,yes,no):
1086       {  return GUARDmatch(e, merge(a,yes), merge(a,no)); }
1087    |  MORE, _, LITERALmatch(p,e,l,n,m,d):
1088       {  Match * br = Matches(n);
1089          for (int i = n - 1; i >= 0; i--) br[i] = merge(a,m[i]);
1090          return LITERALmatch(p,e,l,n,br,merge(a,d));
1091       }
1092    |  MORE, _, CONSmatch(p,e,c,c',n,m,d):
1093       {  Match * br = Matches(n);
1094          for (int i = n - 1; i >= 0; i--) br[i] = merge(a,m[i]);
1095          return CONSmatch (p,e,c,c',n,br,merge(a,d));
1096       }
1097    |  _, _, _: { return compose(a,b); }
1098    }
1099 }
1100
1101 ///////////////////////////////////////////////////////////////////////////////
1102 //
1103 //  Equality between two matching tree.
1104 //
1105 ///////////////////////////////////////////////////////////////////////////////
1106 Bool match_equal (HashTable::Key a, HashTable::Key b)
1107 {  match (Match(a)) and (Match(b))
1108    {  FAILmatch,              FAILmatch:             { return true; }
1109    |  SUCCESSmatch _,         SUCCESSmatch _:        { return a == b; }
1110    |  SUCCESSESmatch (_,a,_), SUCCESSESmatch(_,b,_): { return equal(a,b); }
1111    |  COSTmatch (_,_,a,_),    COSTmatch (_,_,b,_):   { return equal(a,b); }
1112    |  GUARDmatch(e1,a,b),     GUARDmatch(e2,c,d):
1113       {  return equal(e1,e2) && a == c && b == d; }
1114    |  TREECOSTmatch(a,s1,_),  TREECOSTmatch(b,s2,_):
1115       {  return a == b && equal(s1,s2); }
1116    |  TREELABELmatch(a,t1,t2,i), TREELABELmatch(b,t3,t4,j):
1117       {  return a == b && ty_equal(t1,t3) && ty_equal(t2,t4) && i == j; }
1118    |  LITERALmatch (x,_,a,i,b,c), LITERALmatch(y,_,e,j,f,g) | i == j:
1119       {  if (compare_pos(x,y) != SAME) return false;
1120          for (int k = i-1; k >= 0; k--) if (b[k] != f[k]) return false;
1121          return c == g;
1122       }
1123    |  CONSmatch (x,_,_,a,i,b,c), CONSmatch(y,_,_,e,j,f,g) | a == e && i == j:
1124       {  if (compare_pos(x,y) != SAME) return false;
1125          for (int k = i-1; k >= 0; k--) if (b[k] != f[k]) return false;
1126          return c == g;
1127       }
1128    |  RANGEmatch(x,_,lo1,hi1,y1,n1), RANGEmatch(y,_,lo2,hi2,y2,n2):
1129       {  return compare_pos(x,y) == SAME &&
1130                 lo1 == lo2 && hi1 == hi2 && y1 == y2 && n1 == n2;
1131       }
1132    |  _:  { return false; }
1133    }
1134 }
1135
1136 ///////////////////////////////////////////////////////////////////////////////
1137 //
1138 //  Hashing function on a literal.
1139 //
1140 ///////////////////////////////////////////////////////////////////////////////
1141 unsigned int literal_hash (HashTable::Key k)
1142 {  match (Literal(k))
1143    {  INTlit    i: { return i; }
1144    |  BOOLlit   b: { return b; }
1145    |  REALlit   r: { return (unsigned int)r; }
1146    |  STRINGlit s: { return hash(s); }
1147    |  REGEXPlit r: { return hash(r); }
1148    |  CHARlit   c: { return c; }
1149    |  QUARKlit  q: { return hash(q); }
1150    |  BIGINTlit n: { return hash(n); }
1151    }
1152 }
1153
1154 ///////////////////////////////////////////////////////////////////////////////
1155 //
1156 //  Equality function on literals.
1157 //
1158 ///////////////////////////////////////////////////////////////////////////////
1159 Bool literal_equal (HashTable::Key a, HashTable::Key b)
1160 {  return compare_literals((Literal)a, (Literal)b) == 0; }
1161
1162 ///////////////////////////////////////////////////////////////////////////////
1163 //
1164 //  Hashing function on a matching tree.
1165 //
1166 ///////////////////////////////////////////////////////////////////////////////
1167 unsigned int match_hash (HashTable::Key m)
1168 {  match (Match(m))
1169    {  FAILmatch:              { return 0; }
1170    |  DONTCAREmatch:          { return 179; }
1171    |  BACKEDGEmatch (i,_,_):  { return i + 1249; }
1172    |  SUCCESSmatch _:         { return (unsigned int)m; }
1173    |  SUCCESSESmatch (_,a,_): { return 93 + hash (a); }
1174    |  COSTmatch (_,_,a,_):    { return 457 + hash (a); }
1175    |  TREECOSTmatch (a,b,_):  { return hash(b) + (unsigned int)a; }
1176    |  TREELABELmatch(a,t,u,i):{ return ty_hash(t) + ty_hash(u) + i + (unsigned int)a; }
1177    |  GUARDmatch (_,a,b):     { return (unsigned int)a + (unsigned int)b;}
1178    |  RANGEmatch(_,_,lo,hi,y,n):
1179       {  return 235 + lo + hi + (unsigned int)y + (unsigned int)n; }
1180    |  LITERALmatch(_,_,l,n,a,b):
1181       {  unsigned h = 117 + n + (unsigned int)b;
1182          for (int i = n - 1; i >= 0; i--)
1183             h += literal_hash(l[i]) + (unsigned int)a[i];
1184          return h;
1185       }
1186    |  CONSmatch (_,_,_,_,n,a,b):
1187       {  unsigned h = 657 + n + (unsigned int)b;
1188          for (int i = n - 1; i >= 0; i--)
1189             h += (unsigned int)a[i];
1190          return h;
1191       }
1192    }
1193 }
1194
1195 ///////////////////////////////////////////////////////////////////////////////
1196 //
1197 //  Tree to dag conversion for a matching tree.
1198 //
1199 ///////////////////////////////////////////////////////////////////////////////
1200 Match make_dag (Match m, HashTable& map, int& merges)
1201 {  int i;
1202    if (boxed(m)) { m->shared = 0; m->label = 0; }
1203    match (m)
1204    {  LITERALmatch (_,_,l,n,a,b):
1205       {  for (i = n - 1; i >= 0; i--) a[i] = make_dag (a[i], map, merges);
1206          b = make_dag(b, map, merges);
1207          // Eliminate the node if every branch is the same.
1208          for (i = n - 1; i >= 1; i--) if (a[i] != a[i-1]) break;
1209          if (i == 0 && a[0] == b) { merges++; return b; }
1210          // Eliminate all branches that are the same as the default
1211          for (i = 0; i < n; i++)
1212          {  if (a[i] == b)
1213             {  // shift one over
1214                for (int j = i+1; j < n; j++)
1215                {  a[j-1] = a[j]; l[j-1] = l[j]; }
1216                n--;
1217             }
1218          }
1219       }
1220    |  CONSmatch    (_,_,_,_,n,a,b):
1221       {  for (i = n - 1; i >= 0; i--) a[i] = make_dag (a[i], map, merges);
1222          b = make_dag(b, map, merges);
1223          // Eliminate the node if every branch is the same.
1224          for (i = n - 1; i >= 1; i--) if (a[i] != a[i-1]) break;
1225          if (i == 0 && a[0] == b) { merges++; return b; }
1226       }
1227    |  GUARDmatch   (_,a,b):
1228       {  if ((a = make_dag(a,map,merges)) == (b = make_dag(b,map,merges)))
1229          { merges++; return a; }
1230       }
1231    |  RANGEmatch  (_,_,_,_,a,b):
1232       {  if ((a = make_dag(a,map,merges)) == (b = make_dag(b,map,merges)))
1233          { merges++; return a; }
1234       }
1235    |  TREECOSTmatch (a,_,_):    {  a = make_dag(a,map,merges); }
1236    |  TREELABELmatch (a,_,_,_): {  a = make_dag(a,map,merges); }
1237    |  _:  { /* skip */ }
1238    }
1239
1240    HashTable::Entry * found = map.lookup(m);
1241    if (found) {
1242       merges++;
1243       return (Match)found->v;
1244    } else {
1245       map.insert(m,m);
1246       return m;
1247    }
1248 }
1249
1250 ///////////////////////////////////////////////////////////////////////////////
1251 //
1252 //  Mark all sharing
1253 //
1254 ///////////////////////////////////////////////////////////////////////////////
1255 void mark(Match m)
1256 {  if (boxed(m)) m->shared++;
1257    match (m)
1258    {  SUCCESSmatch (_,rule):      { rule->used = true; }
1259    |  FAILmatch || SUCCESSESmatch _ || COSTmatch _:
1260                                   { /* skip */ }
1261    |  GUARDmatch   (_,a,b):       { mark(a); mark(b); }
1262    |  LITERALmatch (_,_,_,n,a,b): { for (int i = n-1; i >= 0; i--) mark(a[i]);
1263                                     mark(b);
1264                                   }
1265    |  RANGEmatch  (_,_,_,_,y,n):  { mark(y); mark(n); }
1266    |  TREECOSTmatch (a,_,_):      { mark(a); }
1267    |  TREELABELmatch (a,_,_,_):   { mark(a); }
1268    |  CONSmatch   (_,_,_,DATATYPEty({ qualifiers, unit, arg ... },_),n,a,b):
1269       {  for (int i = n-1; i >= 0; i--) mark(a[i]);
1270          // if (unit > 0)
1271          // {  int i;
1272          //    for (i = unit - 2; i >= 0; i--) if (a[i] != a[i+1]) break;
1273          //    if (i < 0) mark(a[0]);
1274          //    else       for (i = unit - 1; i >= 0; i--) mark(a[i]);
1275          // }
1276          // if (arg > 0)
1277          // {  int i;
1278          //    for (i = n - 2; i >= unit; i--) if (a[i] != a[i+1]) break;
1279          //    if (i < unit) mark(a[unit]);
1280          //    else          for (i = n - 1; i >= unit; i--) mark(a[i]);
1281          // }
1282          if (qualifiers & QUALextensible) mark(b);
1283       }
1284    |  _: { bug ("mark()"); }
1285    }
1286 }
1287
1288 ///////////////////////////////////////////////////////////////////////////////
1289 //
1290 //  Top level tree to dag conversion.
1291 //
1292 ///////////////////////////////////////////////////////////////////////////////
1293 Match MatchCompiler::make_dag (Match m, MatchOptions options, MatchRules rules)
1294 {  HashTable map(match_hash, match_equal, 257);
1295    m = ::make_dag(m,map,merges);
1296    if (options & MATCHwithtreecost)
1297       m = translate_treecost(m,rules);
1298    mark(m);
1299    return m;
1300 }
1301
1302 ///////////////////////////////////////////////////////////////////////////////
1303 //
1304 //  Check to see if a matching tree is refutable (i.e. can fail.)
1305 //
1306 ///////////////////////////////////////////////////////////////////////////////
1307 Bool refutable (Match m)
1308 {  match while (m)
1309    {  FAILmatch:                                          { return true; }
1310    |  SUCCESSmatch _ ||  SUCCESSESmatch _ || COSTmatch _: { return false; }
1311    |  GUARDmatch (_,a,b): { return refutable(a) || refutable(b); }
1312    |  RANGEmatch (_,_,_,_,a,b): { return refutable(a) || refutable(b); }
1313    |  LITERALmatch (_,_,l,n,a,b):
1314       {  for (int i = n - 1; i >= 0; i--) if (refutable(a[i])) return true;
1315          match (l[0])  // we can only have 2 booleans, duh!
1316          {  BOOLlit _ | n >= 2: { return false; }
1317          |  _:                  { m = b; }
1318          }
1319       }
1320    |  CONSmatch (_,_,_,DATATYPEty({ qualifiers ... },_),n,a,b):
1321       {  for (int i = n - 1; i >= 0; i--) if (refutable(a[i])) return true;
1322          if (! (qualifiers & QUALextensible)) return false;
1323          m = b;
1324       }
1325    |  TREECOSTmatch (a,set,_): { m = a; }
1326    |  TREELABELmatch(a,_,_,_): { m = a; }
1327    |  _: { bug ("refutable()"); }
1328    }
1329 }
1330
1331 ///////////////////////////////////////////////////////////////////////////////
1332 //
1333 //  Compute the set of rules that can possibly match as a bitset.
1334 //
1335 ///////////////////////////////////////////////////////////////////////////////
1336 void matchables (Match m, BitSet& set)
1337 {  match while (m)
1338    {  FAILmatch:                { return; }
1339    |  SUCCESSESmatch (_,s,_):   { set.Union(*s); return; }
1340    |  COSTmatch      (_,_,s,_): { set.Union(*s); return; }
1341    |  SUCCESSmatch   (i,_):     { set.add(i); return; }
1342    |  GUARDmatch (_,a,b):       { matchables(a,set); m = b; }
1343    |  RANGEmatch (_,_,_,_,y,n): { matchables(y,set); m = n; }
1344    |  LITERALmatch (_,_,_,n,a,b):
1345       {  for (int i = n - 1; i >= 0; i--) matchables(a[i],set);
1346          m = b;
1347       }
1348    |  CONSmatch (_,_,_,DATATYPEty({ qualifiers ... },_),n,a,b):
1349       {  for (int i = n - 1; i >= 0; i--) matchables(a[i],set);
1350          if (! (qualifiers & QUALextensible)) return;
1351          m = b;
1352       }
1353    |  TREECOSTmatch (a,s,_):   { set.Union(*s); m = a; }
1354    |  TREELABELmatch(a,_,_,_): { m = a; }
1355    |  _: { bug("matchables()"); }
1356    }
1357 }
1358
1359 ///////////////////////////////////////////////////////////////////////////////
1360 //
1361 //  Compute the set of rules that can always match as a bitset.
1362 //
1363 ///////////////////////////////////////////////////////////////////////////////
1364 void always_matchables (Match m, BitSet& set)
1365 {  match while (m)
1366    {  SUCCESSESmatch (_,s,_):   { set.Intersect(*s); return; }
1367    |  COSTmatch    (_,_,s,_):   { set.Intersect(*s); return; }
1368    |  GUARDmatch (_,a,b):       { always_matchables(a,set); m = b; }
1369    |  RANGEmatch (_,_,_,_,a,b): { always_matchables(a,set); m = b; }
1370    |  LITERALmatch (_,_,_,n,a,b):
1371       {  for (int i = n - 1; i >= 0; i--) always_matchables(a[i],set);
1372          m = b;
1373       }
1374    |  CONSmatch (_,_,_,DATATYPEty({ qualifiers ... },_),n,a,b):
1375       {  for (int i = n - 1; i >= 0; i--) always_matchables(a[i],set);
1376          if (! (qualifiers & QUALextensible)) return;
1377          m = b;
1378       }
1379    |  TREECOSTmatch (a,s,_):   { set.Intersect(*s); m = a; }
1380    |  TREELABELmatch(a,_,_,_): { m = a; }
1381    }
1382 }
1383
1384 ///////////////////////////////////////////////////////////////////////////////
1385 //
1386 //  Top level routine to call the above
1387 //
1388 ///////////////////////////////////////////////////////////////////////////////
1389 const BitSet& always_matchables(Match m, int n)
1390 {  BitSet * set = new (mem_pool, n) BitSet;
1391    set->complement();
1392    always_matchables(m, *set);
1393    return *set;
1394 }