prop-src/funmap.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements the FunctorMap data structure
   4 //
   5 ///////////////////////////////////////////////////////////////////////////////
   6 #include <iostream.h>
   7 #include <strstream.h>
   8 #include <AD/automata/treegram.ph>
   9 #include <AD/automata/treegen.h>
  10 #include <AD/rewrite/burs_gen.h>
  11 #include <AD/strings/quark.h>
  12 #include "funmap.ph"
  13 #include "ir.ph"
  14 #include "ast.ph"
  15 #include "matchcom.ph"
  16 #include "type.h"
  17 #include "hashtab.h"
  18 #include "datagen.h"
  19 #include "config.h"
  20 #include "rwgen.h"
  21 #include "options.h"
  22 #include "list.h"
  23
  24 ///////////////////////////////////////////////////////////////////////////////
  25 //
  26 //  Import some type definitions from the tree grammar and hash table
  27 //  classes.
  28 //
  29 ///////////////////////////////////////////////////////////////////////////////
  30 typedef TreeGrammar::TreeProduction TreeProduction;
  31 typedef TreeGrammar::Cost           TreeCost;
  32 typedef HashTable::Key              Key;
  33 typedef HashTable::Value            Value;
  34
  35 ///////////////////////////////////////////////////////////////////////////////
  36 //
  37 //  Instantiate the vector id type
  38 //
  39 ///////////////////////////////////////////////////////////////////////////////
  40 instantiate datatype VectorId;
  41
  42 ///////////////////////////////////////////////////////////////////////////////
  43 //
  44 //  Hashing and equality on vector id's
  45 //
  46 ///////////////////////////////////////////////////////////////////////////////
  47 unsigned int vector_id_hash(HashTable::Key k)
  48 {  VectorId id = (VectorId)k;
  49    return (unsigned int)id->cons + ty_hash(id->ty) + id->arity;
  50 }
  51 Bool vector_id_equal(HashTable::Key a, HashTable::Key b)
  52 {  VectorId x = (VectorId)a;
  53    VectorId y = (VectorId)b;
  54    return x->cons == y->cons && x->arity == y->arity && ty_equal(x->ty,y->ty);
  55 }
  56
  57 ///////////////////////////////////////////////////////////////////////////////
  58 //
  59 //  Method to decorate cost expression and attribute bindings for
  60 //  a pattern.
  61 //
  62 ///////////////////////////////////////////////////////////////////////////////
  63 int decor_rewrite (Pat pat, int rule, int kid, PatternVarEnv& E)
  64 {  match while (pat)
  65    {  NOpat || LITERALpat _ || CONSpat _: { return kid; }
  66    |  MARKEDpat(_,p):            { pat = p; }
  67    |  TYPEDpat(p,_):             { pat = p; }
  68    |  GUARDpat(p,_):             { pat = p; }
  69    |  APPpat (_,p):              { pat = p; }
  70    |  CONTEXTpat(_,p):           { pat = p; }
  71    |  TUPLEpat ps:
  72       {  return decor_rewrite(ps, rule, kid, E); }
  73    |  LISTpat{nil,cons,head=ps,tail=rest}:
  74       {  kid = decor_rewrite(ps, rule, kid, E); pat = rest; }
  75    |  VECTORpat { len, array, elements, head_flex, tail_flex ... }:
  76       {  kid = decor_rewrite(elements, rule,
  77                   decor_rewrite(array, rule, kid, E), E);
  78          if (head_flex || tail_flex)
  79             error("%Lflexible vector pattern currently not supported in rewriting: %p\n", pat);
  80          pat = len;
  81       }
  82    |  ASpat (id,p,_,_):
  83       {  Id attrib_name = #"#" + id;
  84          Id cost_name   = #"$" + id;
  85          Ty ty = mkvar();
  86          E.add (attrib_name, SYNexp(kid, rule, mkvar(),true), ty, ISpositive);
  87          E.add (cost_name, COSTexp(kid),  ty, ISpositive);
  88          kid = kid+1;
  89          pat = p;
  90       }
  91    |  _:  { return kid; }
  92    }
  93 }
  94
  95 ///////////////////////////////////////////////////////////////////////////////
  96 //
  97 //  Decorate a pattern list.
  98 //
  99 ///////////////////////////////////////////////////////////////////////////////
 100 int decor_rewrite (Pats pats, int rule, int kid, PatternVarEnv& E)
 101 {  for_each (Pat, p, pats) kid = decor_rewrite(p, rule, kid, E);
 102    return kid;
 103 }
 104
 105 ///////////////////////////////////////////////////////////////////////////////
 106 //
 107 //  Decorate rewriting patterns.
 108 //
 109 ///////////////////////////////////////////////////////////////////////////////
 110 int decor_rewrite (Pat pat, int rule, PatternVarEnv& E)
 111 {  Ty ty = mkvar();
 112    E.add (#"##", THISSYNexp(rule,mkvar(),true), ty, ISpositive);
 113    E.add (#"$$", THISCOSTexp(), ty, ISpositive);
 114    return decor_rewrite (pat, rule, 0, E);
 115 }
 116
 117 ///////////////////////////////////////////////////////////////////////////////
 118 //
 119 //  Constructor of the functor mapping table.
 120 //
 121 ///////////////////////////////////////////////////////////////////////////////
 122 FunctorMap::FunctorMap(Id name, MatchRules rules)
 123   : literal_map(literal_hash,literal_equal,129),
 124     var_map    (string_hash,string_equal),
 125     type_map   (ty_hash,ty_equal),
 126     vector_map (vector_id_hash,vector_id_equal),
 127     rule_map   (ty_hash,ty_equal),
 128     topdown_rule_map (ty_hash,ty_equal),
 129     before_rule_map (ty_hash,ty_equal),
 130     preorder_rule_map (ty_hash,ty_equal),
 131     postorder_rule_map (ty_hash,ty_equal),
 132     protocols  (ty_hash,ty_equal),
 133     nonterm_map(string_hash,string_equal),
 134     nonterm_rules(string_hash,string_equal),
 135     nonterm_rules_bits(string_hash,string_equal),
 136     chain_rules(string_hash,string_equal),
 137     bottomup_rules(#[])
 138 {
 139     ///////////////////////////////////////////////////////////////////////////
 140     //
 141     //  Initialize the internals.
 142     //
 143     ///////////////////////////////////////////////////////////////////////////
 144     class_name      = name;
 145     N               = length(rules);
 146     functors        = 0;
 147     variables       = 0;
 148     tree_gen        = 0;
 149     topdown_gen     = 0;
 150     use_compression = true;
 151     has_guard       = false;
 152     has_replacement = false;
 153     has_cost        = false;
 154     has_cost_exp    = false;
 155     has_syn_attrib  = false;
 156     is_applicative  = false;
 157     gen_reducers    = false;
 158     dynamic_search  = false;
 159     max_arity       = 1;
 160     functor_names   = 0;
 161     variable_names  = 0;
 162     is_ok           = true;
 163
 164     rule_maps[MatchRuleInfo::BOTTOMUP]  = &rule_map;
 165     rule_maps[MatchRuleInfo::TOPDOWN]   = &topdown_rule_map;
 166     rule_maps[MatchRuleInfo::BEFORE]    = &before_rule_map;
 167     rule_maps[MatchRuleInfo::PREORDER]  = &preorder_rule_map;
 168     rule_maps[MatchRuleInfo::POSTORDER] = &postorder_rule_map;
 169
 170     TyQual qual = RewritingCompiler::lookup_qual(class_name);
 171     if (qual & QUALtreeparser)  gen_reducers = true;
 172     if (qual & QUALapplicative) is_applicative = true;
 173
 174     int last_errors = errors;
 175     enter_protocols();             // enter the protocols
 176           // partition rule by type
 177     bottomup_rules = partition_rules(rules);
 178     check_for_missing_protocols();
 179     if (errors != last_errors) { is_ok = false; return; }
 180     build_tree_grammar(bottomup_rules);
 181
 182     // BUG fix, always use dynamic search algorithm when treeparser
 183     // mode is on, since the class interface has to match.
 184     //dynamic_search = gen_reducers && (has_cost || has_cost_exp);
 185     dynamic_search = gen_reducers;
 186 }
 187
 188 ///////////////////////////////////////////////////////////////////////////////
 189 //
 190 //  Method to enter the protocols into the protocol map
 191 //
 192 ///////////////////////////////////////////////////////////////////////////////
 193 void FunctorMap::enter_protocols ()
 194 {  Protocols Ps = RewritingCompiler::lookup_protocols(class_name);
 195    {  for_each (Protocol, p, Ps)
 196       {  match (p)
 197          {  PROTOCOL { ty, syn ... }:
 198             {  encode(ty);  protocols.insert(ty,p);
 199                if (syn != NOty) has_syn_attrib = true;
 200             }
 201          }
 202       }
 203    }
 204 }
 205
 206
 207 ///////////////////////////////////////////////////////////////////////////////
 208 //
 209 //  Checks for missing protocol
 210 //
 211 ///////////////////////////////////////////////////////////////////////////////
 212 void FunctorMap::check_for_missing_protocols()
 213 {  foreach_entry (e, type_map)
 214    {  Ty ty = Ty(type_map.key(e));
 215       if (! protocols.contains(ty))
 216       {  error("%Lmissing type %T in the traversal list of rewrite class %s\n",
 217                ty, class_name);
 218       }
 219    }
 220 }
 221
 222 ///////////////////////////////////////////////////////////////////////////////
 223 //
 224 //  Otherwise, build the tree grammar and the functor/variable name maps.
 225 //
 226 ///////////////////////////////////////////////////////////////////////////////
 227 void FunctorMap::build_tree_grammar (MatchRules rules)
 228 {
 229    N = length(rules);
 230    TreeProduction * Ps =
 231        (TreeProduction *)mem_pool.c_alloc(sizeof(TreeProduction) * N);
 232
 233    ////////////////////////////////////////////////////////////////////////////
 234    //
 235    //  Translate patterns into terms
 236    //
 237    ////////////////////////////////////////////////////////////////////////////
 238    {  int i = 0;
 239       for_each (MatchRule, r, rules)
 240       {  match (r)
 241          {  MATCHrule(lhs,pat,guard,cost,_):
 242             {  int rule_no = lhs ? var_map[lhs] : 0;
 243                int cst;
 244                match (cost)
 245                {  NOcost:     { cst = 0; }
 246                |  INTcost c:  { cst = c; has_cost = true; }
 247                |  EXPcost _:  { cst = 0; has_cost_exp = true; }
 248                }
 249                Ps[i] = TreeProduction(rule_no,trans(pat),cst);
 250                if (guard != NOexp || (r->option & MatchRuleInfo::FAILREWRITE))
 251                    has_guard = true;
 252                if (r->option & MatchRuleInfo::REPLACEMENT)
 253                    has_replacement = true;
 254                i++;
 255             }
 256          }
 257       }
 258    }
 259
 260    ////////////////////////////////////////////////////////////////////////////
 261    //
 262    //  Compute the functor/variable names
 263    //
 264    ////////////////////////////////////////////////////////////////////////////
 265    compute_names();
 266
 267    ////////////////////////////////////////////////////////////////////////////
 268    //
 269    //  Compile the tree grammar
 270    //
 271    ////////////////////////////////////////////////////////////////////////////
 272    G.compile (N, Ps, functor_names, variable_names, 0, functors - 1, 0);
 273 }
 274
 275 ///////////////////////////////////////////////////////////////////////////////
 276 //
 277 //  Method to convert literal patterns inside a set of matching rules
 278 //  into guards
 279 //
 280 ///////////////////////////////////////////////////////////////////////////////
 281 void FunctorMap::make_guard (MatchRules rules)
 282 {  match while (rules)
 283    {  #[MATCHrule(_,pat,guard,_,_) ... rest]:
 284       {  pat   = make_guard(pat, guard);
 285          rules = rest;
 286       }
 287    }
 288 }
 289
 290 ///////////////////////////////////////////////////////////////////////////////
 291 //
 292 //  Method to convert literal patterns into guards.
 293 //
 294 ///////////////////////////////////////////////////////////////////////////////
 295 Pat FunctorMap::make_guard (Pat pat, Exp& e)
 296 {  Pat new_pat;
 297    // return pat; // BUG fix
 298    match (pat)
 299    {  ASpat(a,p,b,c):        { new_pat = ASpat(a,make_guard(p,e),b,c); }
 300    |  TYPEDpat(p,ty):        { new_pat = TYPEDpat(make_guard(p,e),ty); }
 301    |  MARKEDpat(loc,p):      { new_pat = MARKEDpat(loc,make_guard(p,e)); }
 302    |  TUPLEpat ps:           { new_pat = TUPLEpat(make_guard(ps,e)); }
 303    |  RECORDpat(lab_pats,f): { new_pat = RECORDpat(make_guard(lab_pats,e),f); }
 304    |  APPpat(a,b):           { new_pat = APPpat(make_guard(a,e),make_guard(b,e)); }
 305    |  LITERALpat (l as (INTlit _ || REALlit _ || CHARlit _ || BOOLlit _)):
 306       {  Exp guard_exp = BINOPexp("==",pat->selector,LITERALexp(l));
 307          e = e == NOexp ? guard_exp : BINOPexp("&&",e,guard_exp);
 308          new_pat = WILDpat();
 309       }
 310    |  LISTpat{cons,nil,head=ps,tail=p}:
 311       {  new_pat = LISTpat'{cons = cons, nil = nil,
 312                             head = make_guard(ps,e), tail = make_guard(p,e)};
 313       }
 314    |  VECTORpat { cons, elements, array, len, head_flex, tail_flex  }:
 315       {  new_pat = VECTORpat'{ cons      = cons,
 316                                elements  = make_guard(elements,e),
 317                                array     = make_guard(array,e),
 318                                len       = make_guard(len,e),
 319                                head_flex = head_flex,
 320                                tail_flex = tail_flex
 321                              };
 322       }
 323    |  _: { new_pat = pat; }
 324    }
 325    if (new_pat != pat && boxed(new_pat))
 326    {  new_pat->ty = pat->ty;
 327       new_pat->selector = pat->selector;
 328    }
 329    return new_pat;
 330 }
 331
 332 ///////////////////////////////////////////////////////////////////////////////
 333 //
 334 //  Unguard a pattern list
 335 //
 336 ///////////////////////////////////////////////////////////////////////////////
 337 Pats FunctorMap::make_guard (Pats ps, Exp& e)
 338 {  match (ps)
 339    {  #[]:        { return #[]; }
 340    |  #[h ... t]: { return #[make_guard(h,e) ... make_guard(t,e)]; }
 341    }
 342 }
 343
 344 ///////////////////////////////////////////////////////////////////////////////
 345 //
 346 //  Unguard a labeled pattern list
 347 //
 348 ///////////////////////////////////////////////////////////////////////////////
 349 LabPats FunctorMap::make_guard (LabPats ps, Exp& e)
 350 {  match (ps)
 351    {  #[]:        { return #[]; }
 352    |  #[h ... t]: { LabPat lab_pat;
 353                     lab_pat.label = h.label;
 354                     lab_pat.pat   = make_guard(h.pat,e);
 355                     return #[lab_pat ... make_guard(t,e)];
 356                   }
 357    }
 358 }
 359
 360 ///////////////////////////////////////////////////////////////////////////////
 361 //
 362 //  Check whether we know of the type
 363 //
 364 ///////////////////////////////////////////////////////////////////////////////
 365 Bool FunctorMap::is_known_type(Ty ty)
 366 {  return type_map.contains(ty)      ||
 367           ty_equal(ty, string_ty)    ||
 368           ty_equal(ty, quark_ty)
 369 //        ty_equal(ty, integer_ty)   ||
 370 //        ty_equal(ty, bool_ty)      ||
 371 //        ty_equal(ty, real_ty)      ||
 372 //        ty_equal(ty, character_ty)
 373    ;
 374 }
 375
 376 ///////////////////////////////////////////////////////////////////////////////
 377 //
 378 //  Check whether we the type is rewritable.
 379 //
 380 ///////////////////////////////////////////////////////////////////////////////
 381 Bool FunctorMap::is_rewritable_type(Ty ty) { return type_map.contains(ty); }
 382
 383 ///////////////////////////////////////////////////////////////////////////////
 384 //
 385 //  Method to assign variable encoding to a non-terminal
 386 //
 387 ///////////////////////////////////////////////////////////////////////////////
 388 void FunctorMap::encode (Id id)
 389 {  if (! var_map.contains(id))
 390    {  ++variables; var_map.insert(id,variables);
 391    }
 392 }
 393
 394 ///////////////////////////////////////////////////////////////////////////////
 395 //
 396 //  Method to assign functor encoding to a type
 397 //
 398 ///////////////////////////////////////////////////////////////////////////////
 399 void FunctorMap::encode (Ty ty)
 400 {  match (deref_all(ty))
 401    {  ty as TYCONty(DATATYPEtycon { unit, arg ... }, _):
 402       {  if (! type_map.contains(ty))
 403          {  type_map.insert(ty, functors);
 404             functors += unit + arg;
 405          }
 406       }
 407    |  TYCONty(_,tys): {  for_each(Ty, ty, tys) encode(ty); }
 408    |  _:  // skip
 409    }
 410 }
 411
 412 ///////////////////////////////////////////////////////////////////////////////
 413 //
 414 //  Method to assign functor encoding to a pattern.
 415 //  Assign a functor value to each distinct literal and pattern constructor.
 416 //
 417 ///////////////////////////////////////////////////////////////////////////////
 418 void FunctorMap::encode(Pat pat)
 419 {  match while (pat)
 420    {  NOpat || WILDpat _ || IDpat _: { return; }
 421    |  ASpat(_,p,_,_):  { pat = p; }
 422    |  TYPEDpat(p,_):   { pat = p; }
 423    |  MARKEDpat(_,p):  { pat = p; }
 424    |  TUPLEpat ps:
 425       {  int i = 0;
 426          for_each (Pat, p, ps) { i++; encode(p); }
 427          if (max_arity < i) max_arity = i;
 428          return;
 429       }
 430    |  RECORDpat(lab_pats,_):
 431       {  for_each (LabPat, p, lab_pats) { encode(p.pat); }
 432          int arity = arity_of(pat->ty);
 433          if (max_arity < arity) max_arity = arity;
 434          return;
 435       }
 436    |  LITERALpat (l as (QUARKlit _ || STRINGlit _ || REGEXPlit _)):
 437       {  if (! literal_map.contains(l))
 438          {  literal_map.insert(l,functors);
 439             functors++;
 440          }
 441          return;
 442       }
 443    |  LITERALpat (INTlit _ || REALlit _ || CHARlit _ || BOOLlit _):
 444       { bug ("%Luntransformed literal pattern %p found in rewriting\n",pat); }
 445    |  CONSpat(ONEcons
 446               { alg_ty = alg_ty as
 447                    TYCONty(DATATYPEtycon { unit, arg, terms ... },_)
 448                 ... }):
 449       {  if (pat->ty != NOty && ! type_map.contains(pat->ty))
 450          {  type_map.insert(pat->ty, functors);
 451             functors += unit + arg;
 452          }
 453          return;
 454       }
 455    |  APPpat(a,b):  { encode(pat->ty); pat = b; }
 456    |  LISTpat{cons,nil,head=ps,tail=p}:
 457       {  Pat new_pat = CONSpat(nil);
 458          new_pat->ty = pat->ty;
 459          encode(new_pat);
 460          for_each (Pat, i, ps) encode(i);
 461          if (max_arity < 2) max_arity = 2;
 462          pat = p;
 463       }
 464    |  VECTORpat { cons, elements ... }:
 465       {  Pat new_pat = CONSpat(cons);
 466          new_pat->ty = pat->ty;
 467          encode(new_pat);
 468          for_each (Pat, p, elements) encode(p);
 469          int l = length(elements);
 470          if (max_arity < l) max_arity = l;
 471          if (pat->ty != NOty)
 472          {  VectorId vec_id = vector_id(cons,pat->ty,l);
 473             if ( ! vector_map.contains(vec_id))
 474             {  vector_map.insert(vec_id, functors);
 475                functors++;
 476             }
 477          }
 478          return;
 479       }
 480    |  _: { error ("%LSorry: pattern not supported in rewriting: %p\n", pat); return; }
 481    }
 482 }
 483
 484 ///////////////////////////////////////////////////////////////////////////////
 485 //
 486 //  Method to translate a pattern into a term.
 487 //
 488 ///////////////////////////////////////////////////////////////////////////////
 489 TreeTerm FunctorMap::trans(Pat pat)
 490 {  match while (pat)
 491    {  NOpat || WILDpat _: { return wild_term; }
 492    |  ASpat(_,p,_,_):     { pat = p; }
 493    |  TYPEDpat(p,_):      { pat = p; }
 494    |  MARKEDpat(_,p):     { pat = p; }
 495    |  LITERALpat (l as (QUARKlit _ || STRINGlit _ || REGEXPlit _)):
 496       {  return new_term(mem_pool,literal_map[l]); }
 497    |  LITERALpat l:
 498       {  return wild_term; }
 499    |  IDpat (id,_,_):
 500       {  return var_map.contains(id) ? var_term(var_map[id]) : wild_term;
 501       }
 502    |  TUPLEpat pats:
 503       {  int arity = length (pats);
 504          TreeTerm * subterms =
 505             (TreeTerm *)mem_pool.c_alloc(sizeof(TreeTerm) * arity);
 506          int i = 0;
 507          for_each (Pat, p, pats)
 508          {  subterms[i++] = trans(p); }
 509          return new_term(mem_pool,0,arity,subterms);
 510       }
 511    |  RECORDpat (lab_pats,_):
 512       {  match (deref(pat->ty))
 513          {  RECORDty (labels,_,tys):
 514             {  Bool relevant[256]; int i; int arity;
 515                i = arity = 0;
 516                for_each(Ty, t, tys)
 517                {  if (relevant[i++] = is_known_type(t)) arity++; }
 518                TreeTerm * subterms =
 519                   (TreeTerm *)mem_pool.c_alloc(sizeof(TreeTerm) * arity);
 520                for (i = 0; i < arity; i++)
 521                   subterms[i] = wild_term;
 522                for_each (LabPat, p, lab_pats)
 523                {  Ids labs; Tys ts;
 524                   for (i = 0, labs = labels, ts = tys;
 525                        labs && ts; labs = labs->#2, ts = ts->#2)
 526                   {  if (p.label == labs->#1)
 527                      {  subterms[i] = trans(p.pat); break; }
 528                      if (is_known_type(ts->#1)) i++;
 529                   }
 530                }
 531                return new_term(mem_pool,0,arity,subterms);
 532             }
 533          |  _: { bug("%Lillegal record pattern %p\n", pat); }
 534          }
 535       }
 536    |  APPpat(CONSpat(ONEcons
 537               { ty = arg_ty, tag,
 538                 alg_ty = TYCONty(DATATYPEtycon { unit ... },_) ...
 539               }), p):
 540       {  TreeTerm a = trans(p);
 541          match (arity_of(arg_ty)) and (a)
 542          {  1, _:
 543             {  return new_term(mem_pool,type_map[pat->ty]+unit+tag,1,&a);
 544             }
 545          |  _, tree_term(f,_,_):
 546             {  f = type_map[pat->ty]+unit+tag; return a; }
 547          |  n, _:
 548             {  return new_term(mem_pool, type_map[pat->ty]+unit+tag, n);
 549             }
 550          }
 551       }
 552    |  CONSpat(ONEcons { tag ... }):
 553       {  return new_term(mem_pool, type_map[pat->ty]+tag); }
 554    |  LISTpat{ nil, head = #[], tail = NOpat ... }:
 555       {  Pat p = CONSpat(nil); p->ty = pat->ty; pat = p; }
 556    |  LISTpat{ head = #[], tail ... }:   {  pat = tail; }
 557    |  LISTpat{ cons, nil, head = #[h ... t], tail }:
 558       {  Pat new_tail = LISTpat'{cons=cons,nil=nil,head=t,tail=tail};
 559          Pat new_p    = APPpat(CONSpat(cons),TUPLEpat(#[h, new_tail]));
 560          new_p->ty    = new_tail->ty = pat->ty;
 561          pat = new_p;
 562       }
 563    |  VECTORpat { cons, elements ... }:
 564       {  TreeTerm a     = trans(TUPLEpat(elements));
 565          int      arity = length(elements);
 566          match (a)
 567          {  tree_term(f,_,_):
 568             {  f = vector_map[vector_id(cons,pat->ty,arity)];
 569                return a;
 570             }
 571          |  _:
 572             { bug ("%Lillegal pattern: %p\n", pat); return wild_term; }
 573          }
 574       }
 575    |  _: { error ("%LSorry: pattern not supported: %p\n", pat); return wild_term; }
 576    }
 577 }
 578
 579 ///////////////////////////////////////////////////////////////////////////////
 580 //
 581 //  Compute ceil(ln(2))
 582 //
 583 ///////////////////////////////////////////////////////////////////////////////
 584 int ln2 (int n)
 585 {  int bits = 0;
 586    while (n > 0) { n >>= 1; bits++; }
 587    return bits;
 588 }
 589
 590 ///////////////////////////////////////////////////////////////////////////////
 591 //
 592 //  Method to compute the rhs non-terminal (if it is a chain rule)
 593 //  Otherwise, returns NIL.
 594 //
 595 ///////////////////////////////////////////////////////////////////////////////
 596 Id FunctorMap::chain_rule_rhs (Pat pat)
 597 {  match (pat)
 598    {  IDpat (id,_,_): { return var_map.contains(id) ? id : 0; }
 599    |  ASpat(_,p,_,_): { return chain_rule_rhs(p); }
 600    |  MARKEDpat(_,p): { return chain_rule_rhs(p); }
 601    |  TYPEDpat(p,_):  { return chain_rule_rhs(p); }
 602    |  _:              { return 0; }
 603    }
 604 }
 605
 606 ///////////////////////////////////////////////////////////////////////////////
 607 //
 608 //  Method to partition the set of rules according to the types of the
 609 //  patterns.  Also encode the patterns in the process.
 610 //
 611 ///////////////////////////////////////////////////////////////////////////////
 612 MatchRules FunctorMap::partition_rules (MatchRules rules)
 613 {  bottomup_rules = #[];
 614    // First, we assign a new type variable for each lhs non-terminal.
 615    {  for_each (MatchRule, r, rules)
 616       {  match (r)
 617          {  MATCHrule(lhs,_,_,_,_):
 618             {  if (r->mode == MatchRuleInfo::BOTTOMUP)
 619                {  bottomup_rules = #[ r ... bottomup_rules ];
 620                   if (lhs)
 621                   {  HashTable::Entry * lhs_entry = nonterm_map.lookup(lhs);
 622                      if (! lhs_entry) nonterm_map.insert(lhs,mkvar());
 623                      encode(lhs);  // compute encoding for the variable
 624                      HashTable::Entry * e = nonterm_rules.lookup(lhs);
 625                      if (! e) nonterm_rules.insert(lhs,#[r]);
 626                      else { e->v = #[ r ... MatchRules(e->v)]; }
 627                   } else if (dynamic_search)
 628                      error("%!missing non-terminal in tree grammar rule: %r\n",
 629                            r->loc(), r);
 630                } else if (lhs)
 631                {  error("%!illegal non-terminal in non bottom-up rule: %r\n",
 632                         r->loc(), r);
 633                }
 634             }
 635          }
 636       }
 637    }
 638
 639    bottomup_rules = rev(bottomup_rules);
 640
 641    // Compute the size needed to encode each non-terminal
 642    {  foreach_entry (e, nonterm_rules)
 643       {  int bits = ln2(length(MatchRules(e->v))+1);
 644          nonterm_rules_bits.insert(e->k,HashTable::Value(bits));
 645       }
 646    }
 647
 648    // Type check all the rules next.
 649    // We have to also compute the type map for each lhs non-terminal.
 650    // Of course, a non-terminal but have only one single type.
 651    // This is done by unifying all occurances of a non-terminal.
 652
 653    patvar_typemap = &nonterm_map; // set the pattern variable type map
 654
 655    for_each (MatchRule, r, bottomup_rules)
 656    {  match (r)
 657       {  MATCHrule(lhs,pat,_,_,_):
 658          {  r->set_loc();
 659             Ty ty = r->ty = type_of(pat);
 660
 661             // Check the type of the non-terminal (if any).
 662             if (lhs)
 663             {  Ty lhs_ty = Ty(nonterm_map.lookup(lhs)->v);
 664                if (! unify(lhs_ty, ty))
 665                {  error("%!type mismatch between nonterminal %s(type %T) and rule %r(type %T)\n",
 666                         r->loc(),lhs,lhs_ty,r,ty);
 667                }
 668             }
 669
 670             if (! is_datatype(ty))
 671                error ("%!rule %r is of a non datatype: %T\n",r->loc(),r,ty);
 672
 673             // Collect chain rules.
 674             if (lhs)
 675             {  Id rhs = chain_rule_rhs(pat);
 676                if (rhs)
 677                {  HashTable::Entry * cr = chain_rules.lookup(rhs);
 678                   if (! cr) chain_rules.insert(rhs, #[r]);
 679                   else { cr->v = #[ r ... MatchRules(cr->v)]; }
 680                   r->is_chain_rule = true;
 681                }
 682             }
 683          }
 684       }
 685    }
 686
 687    patvar_typemap = 0; // reset the pattern variable type map
 688
 689    // Now partition rules by type and assign functor encoding.
 690    // Since we have also typed the rules, this is quite simple: just
 691    // another pass.  We have to make sure that after the type inference
 692    // we don't have any more polymorphic types inside the patterns.
 693    int rule_num = 0;
 694    for_each (MatchRule, R, rules)
 695    {  match (R)
 696       {  MATCHrule(_,pat,guard,_,_) | R->mode != MatchRuleInfo::BOTTOMUP:
 697          {  R->set_loc();
 698             R->ty = type_of(pat);
 699             HashTable::Entry * e = rule_maps[R->mode]->lookup(R->ty);
 700             if (e) e->v = #[ R ... (MatchRules)e->v ];
 701             else rule_maps[R->mode]->insert(R->ty,#[ R ]);
 702          }
 703       |  MATCHrule(_,pat,guard,_,_):
 704          {  if (! is_ground(R->ty))
 705                error ("%!rule %r has incomplete type %T\n",R->loc(),R,R->ty);
 706
 707             HashTable::Entry * e = rule_map.lookup(R->ty);
 708             if (e) e->v = #[ R ... (MatchRules)e->v ];
 709             else rule_map.insert(R->ty,#[ R ]);
 710
 711             // convert literals into guards
 712             // BUG: 2-6-97  This doesn't work right since
 713             // the guard testing is not prioritized properly !!!
 714             pat = make_guard (pat, guard);
 715
 716             // assign functor encoding
 717             encode(pat);
 718
 719             R->rule_number = rule_num++;
 720          }
 721       }
 722    }
 723
 724    return bottomup_rules;
 725 }
 726
 727 ///////////////////////////////////////////////////////////////////////////////
 728 //
 729 //  Method to compute the functor and variable table.
 730 //
 731 ///////////////////////////////////////////////////////////////////////////////
 732 void FunctorMap::compute_names ()
 733 {
 734    functor_names  = (Id *)mem_pool.c_alloc(sizeof(Id) * functors);
 735    variable_names = (Id *)mem_pool.c_alloc(sizeof(Id) * (variables + N + 4));
 736
 737    {  for (int i = N + variables - 1; i >= 0; i--) variable_names[i] = 0; }
 738    {  for (int i = functors - 1; i >= 0; i--)  functor_names[i] = "???"; }
 739    variable_names[0] = "_";
 740
 741    // Compute variable names
 742    {  foreach_entry (i,var_map)
 743         variable_names[var_map.value(i)] = (Id)var_map.key(i);
 744    }
 745
 746    // Compute literal names
 747    {  foreach_entry (i,literal_map)
 748       {  Literal l = (Literal)literal_map.key(i);
 749          Functor f = literal_map.value(i);
 750          char buf[1024];
 751          ostrstream b(buf,sizeof(buf));
 752          ostream& s = b;
 753          s << l << ends;
 754          functor_names[f] = Quark(buf);
 755       }
 756    }
 757
 758    // Compute constructor names
 759    {  foreach_entry (i,type_map)
 760       {  Ty      t = (Ty)type_map.key(i);
 761          Functor f = type_map.value(i);
 762          match (deref(t))
 763          {  TYCONty(DATATYPEtycon { unit, arg, terms ... },_):
 764             {  int arity = unit + arg;
 765                for (int j = 0; j < arity; j++)
 766                {  match (terms[j])
 767                   {  ONEcons { name, ty, tag ... }:
 768                      {  functor_names[f + (ty == NOty ? tag : tag + unit)] =
 769                            name;
 770                      }
 771                   |  _: // skip
 772                   }
 773                }
 774             }
 775          |  _: { bug ("compute_names()"); }
 776          }
 777       }
 778    }
 779
 780    // Compute vector constructor names
 781    {  foreach_entry (i, vector_map)
 782       {  VectorId id = (VectorId)vector_map.key(i);
 783          Functor  f  = vector_map.value(i);
 784          if (id->cons) functor_names[f] = id->cons->name;
 785       }
 786    }
 787 }
 788
 789 ///////////////////////////////////////////////////////////////////////////////
 790 //
 791 //  Method to print a report detailing the functor/variable encoding,
 792 //  the tree grammar and the generated table size.
 793 //
 794 ///////////////////////////////////////////////////////////////////////////////
 795 void FunctorMap::print_report (ostream& log)
 796 {
 797    if (var_map.size() > 0)
 798    {  log << "Variable encoding:\n";
 799       foreach_entry (e, var_map)
 800       {  log << "\tnon-terminal \"" << (Id)var_map.key(e) << "\"\t=\t"
 801              << var_map.value(e) << '\n';
 802       }
 803    }
 804
 805    if (literal_map.size() > 0)
 806    {  log << "\nFunctor encoding for literals:\n";
 807       foreach_entry (e, literal_map)
 808       {  log << "literal " << (Literal)literal_map.key(e) << "\t=\t"
 809              << literal_map.value(e) << '\n';
 810       }
 811    }
 812
 813    log << "\nFunctor encoding for constructors:\n";
 814
 815    {  foreach_entry (e, type_map)
 816       {  Ty      t = (Ty)type_map.key(e);
 817          Functor f = type_map.value(e);
 818          log << "datatype " << t << ":\n";
 819          match (deref(t))
 820          {  TYCONty(DATATYPEtycon { unit, arg, terms ... },_):
 821             {  int arity = unit + arg;
 822                for (int i = 0; i < arity; i++)
 823                {  match (terms[i])
 824                   {  ONEcons { name, ty, tag ... }:
 825                      {  log << '\t' << name << "\t=\t"
 826                             << f + (ty == NOty ? tag : tag + unit) << '\n';
 827                      }
 828                   |  _: // skip
 829                   }
 830                }
 831             }
 832          |  _: // skip
 833          }
 834       }
 835    }
 836
 837    if (tree_gen)
 838    {
 839       log << "\nIndex compression is "
 840           << (use_compression ? "enabled" : "disabled")
 841           << "\nAlgorithm is " << tree_gen->algorithm();
 842       tree_gen->print_report(log);
 843    }
 844 }
 845
 846 ///////////////////////////////////////////////////////////////////////////////
 847 //
 848 //  Method to return the cost expression for a pattern.
 849 //
 850 ///////////////////////////////////////////////////////////////////////////////
 851 Exp FunctorMap::cost_expr (Id lhs, Pat pat)
 852 {  match (pat)
 853    {  NOexp:   { return LITERALexp(INTlit(0)); }
 854    |  _:       { return cost_expr(lhs,pat,LITERALexp(INTlit(1))); }
 855    }
 856 }
 857
 858 ///////////////////////////////////////////////////////////////////////////////
 859 //
 860 //  Method to compute the cost expression for a pattern
 861 //
 862 ///////////////////////////////////////////////////////////////////////////////
 863 Exp FunctorMap::cost_expr (Id lhs, Pat pat, Exp exp)
 864 {  match (pat)
 865    {  NOpat || LITERALpat _ ||  CONSpat _: { return exp; }
 866    |  ASpat (_,p,_,_): { return cost_expr(lhs,p,exp); }
 867    |  MARKEDpat(_,p):  { return cost_expr(lhs,p,exp); }
 868    |  TYPEDpat(p,_):   { return cost_expr(lhs,p,exp); }
 869    |  GUARDpat(p,_):   { return cost_expr(lhs,p,exp); }
 870    |  APPpat (_,p):    { return cost_expr(lhs,p,exp); }
 871    |  CONTEXTpat(_,p): { return cost_expr(lhs,p,exp); }
 872    |  TUPLEpat ps:     { return cost_expr(lhs,ps,exp); }
 873    |  EXTUPLEpat ps:   { return cost_expr(lhs,ps,exp); }
 874    |  ARRAYpat (ps,_): { return cost_expr(lhs,ps,exp); }
 875    |  RECORDpat(lab_pats,_): { return cost_expr(lhs,lab_pats,exp); }
 876    |  LISTpat{head,tail ...}:
 877           { return cost_expr(lhs,head,cost_expr(lhs,tail,exp)); }
 878    |  VECTORpat { len, array, elements ... }:
 879           { return cost_expr(lhs,len,cost_expr(lhs,array,
 880                            cost_expr(lhs,elements,exp))); }
 881    |  IDpat (id,_,_):  // skip
 882    |  WILDpat _:       // skip
 883    |  _:               { return exp; }
 884    }
 885
 886    // BUG fix: if the argument type is not a datatype or
 887    // not rewritable, then there is no cost to consider.
 888    if (! is_datatype(pat->ty) || ! is_rewritable_type(pat->ty))
 889       return exp;
 890
 891    Ty state_rec_ty = mkptrty(mkidty(Quark(class_name,"_StateRec"),#[]));
 892    Exp cost_e =
 893       INDEXexp(
 894         ARROWexp(
 895            CASTexp(state_rec_ty,
 896                APPexp(ARROWexp(pat->selector,"get_state_rec"), TUPLEexp(#[]))),
 897                "cost"), LITERALexp(INTlit(int(var_map[lhs]))));
 898    return exp == NOexp ? cost_e : BINOPexp("+",cost_e,exp);
 899 }
 900
 901 ///////////////////////////////////////////////////////////////////////////////
 902 //
 903 //  Method to compute the cost expression for a pattern list
 904 //
 905 ///////////////////////////////////////////////////////////////////////////////
 906 Exp FunctorMap::cost_expr (Id lhs, Pats pats, Exp exp)
 907 {  match (pats)
 908    {  #[]:         { return exp; }
 909    |  #[h ... t]:  { return cost_expr(lhs,h,cost_expr(lhs,t,exp)); }
 910    }
 911 }
 912
 913 ///////////////////////////////////////////////////////////////////////////////
 914 //
 915 //  Method to compute the cost expression for a labeled pattern list
 916 //
 917 ///////////////////////////////////////////////////////////////////////////////
 918 Exp FunctorMap::cost_expr (Id lhs, LabPats pats, Exp exp)
 919 {  match (pats)
 920    {  #[]:         { return exp; }
 921    |  #[h ... t]:  { return cost_expr(lhs,h.pat,cost_expr(lhs,t,exp)); }
 922    }
 923 }
 924