prop-src/rwmix.pcc.old

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements the rewriting partial evaluator/supercompiler.
   4 //  This is used to optimize Prop's rewriting systems.
   5 //
   6 ///////////////////////////////////////////////////////////////////////////////
   7 #include "ast.ph"
   8 #include "ir.ph"
   9 #include "rwmix.ph"
  10 #include "patenv.h"
  11 #include "type.h"
  12 #include "funmap.h"
  13 #include "options.h"
  14
  15 ///////////////////////////////////////////////////////////////////////////////
  16 //
  17 //  Type definitions
  18 //
  19 ///////////////////////////////////////////////////////////////////////////////
  20 typedef RewriteMix::Result Result;
  21 type sharing Bool = bool;
  22
  23 ///////////////////////////////////////////////////////////////////////////////
  24 //
  25 //  The constructors and destructors
  26 //
  27 ///////////////////////////////////////////////////////////////////////////////
  28 RewriteMix::RewriteMix() { reduction_limit = 10; }
  29 RewriteMix::~RewriteMix() {}
  30
  31 ///////////////////////////////////////////////////////////////////////////////
  32 //
  33 //  Method to optimize a set of rewrite rules
  34 //
  35 ///////////////////////////////////////////////////////////////////////////////
  36 MatchRules RewriteMix::optimize_rewrite (Id id, MatchRules rules)
  37 {  if (options.optimize_rewrite)
  38    {  msg ("%Lpartial evaluating rewrite class %s\n", id);
  39       rules = mix(rules);
  40       msg ("%Lfinished partial evaluating rewrite class %s\n", id);
  41    }
  42    return rules;
  43 }
  44
  45 ///////////////////////////////////////////////////////////////////////////////
  46 //
  47 //  Method to partially evaluate a set of rules
  48 //
  49 ///////////////////////////////////////////////////////////////////////////////
  50 MatchRules RewriteMix::mix (MatchRules rules)
  51 {
  52    for_each (MatchRule, rule, rules)
  53    {  match (rule)
  54       {  MATCHrule(_,_,_,_,act as #[MARKEDdecl(l,REPLACEMENTdecl(rhs,mode))]):
  55          {  if (rhs != NOexp)
  56             {  debug_msg("PE [partial evaluating %r]\n", rule);
  57                Exp new_rhs = subst(rhs,0);
  58                new_rhs = simplify(new_rhs,IDexp(#"(redex)"));
  59                Bool reduced = false;
  60                Exp reduced_rhs = normalize(new_rhs,rules,reduced);
  61                if (reduced)
  62                {  rewrite (reduced_rhs) type (Exp, Exps)
  63                   {  IDexp("(redex)"):  IDexp(#"redex")
  64                   }
  65                   msg("%!optimizing rhs of rule %r --> %e\n",
  66                       rule->loc(),rule,reduced_rhs);
  67                   rhs = reduced_rhs;
  68                }
  69             }
  70          }
  71       |  _: // skip
  72       }
  73    }
  74    return rules;
  75 }
  76
  77 ///////////////////////////////////////////////////////////////////////////////
  78 //
  79 //  Method to normalizes an expression with respect to a set
  80 //  of rewrite rules.
  81 //
  82 ///////////////////////////////////////////////////////////////////////////////
  83 Exp RewriteMix::normalize (Exp exp, MatchRules rules, Bool& reduced)
  84 {  Exp redex = exp;
  85    Bool changed;
  86    int limit = reduction_limit;
  87    do
  88    {  changed = false;
  89       match (redex)
  90       {  APPexp(_,TUPLEexp es):
  91          {  for(Exps exps = es; exps; exps=exps->#2)
  92             {  Exp ne = normalize(exps->#1,rules,reduced);
  93                if (ne != exps->#1) { exps->#1 = ne; changed = true; }
  94             }
  95          }
  96       |  APPexp(_,RECORDexp es):
  97          {  for(LabExps exps = es; exps; exps=exps->#2)
  98             {  Exp ne = normalize(exps->#1.exp,rules,reduced);
  99                if (ne != exps->#1.exp)
 100                { exps->#1.exp = ne; changed = true; }
 101             }
 102          }
 103       |  APPexp(_,e):
 104          {  Exp ne = normalize(e,rules,reduced);
 105             if (ne != e) { e = ne; changed = true; }
 106          }
 107       |  _: // skip
 108       }
 109       Exp replacement = NOexp;
 110       Result r = reduce(redex, rules, replacement);
 111       if (r == SUCCESS) {
 112          changed = true;
 113          redex = replacement;
 114       }
 115       if (changed) reduced = true;
 116    } while (changed && --limit >= 0);
 117    debug_msg("PE [%e normalizes to %e]\n",exp,redex);
 118    return redex;
 119 }
 120
 121 ///////////////////////////////////////////////////////////////////////////////
 122 //
 123 //  Method to match an expression against a set of rules.
 124 //
 125 ///////////////////////////////////////////////////////////////////////////////
 126 Result RewriteMix::reduce (Exp redex, MatchRules rules, Exp& replacement)
 127 {
 128    for_each (MatchRule, rule, rules)
 129    {  match (rule)
 130       {  MATCHrule(_,pat,guard,_,action):
 131          {  Result r = pmatch(pat,redex);
 132             if (r == UNKNOWN)
 133             {  debug_msg("PE [%e is unknown at %r]\n",redex,rule);
 134                return UNKNOWN;
 135             }
 136             if (r == FAILURE) goto try_next;
 137             if (guard != NOexp)
 138             {  Exp guard_exp = subst(guard,0);
 139                match (simplify(guard_exp))
 140                {  LITERALexp(BOOLlit true):  { r = SUCCESS; }
 141                |  LITERALexp(BOOLlit false): { goto try_next; }
 142                |  _:
 143                   {  debug_msg("PE [%e fails guard at %r]\n",redex,rule);
 144                      return UNKNOWN;
 145                   }
 146                }
 147             }
 148             // success
 149             Decl decl = NOdecl;
 150             match (action)
 151             {  #[d : Decl]: { decl = d; }
 152             |  _:
 153                {  debug_msg("PE [%e has unknown action at %r]\n",redex,rule);
 154                   return UNKNOWN;
 155                }
 156             }
 157             // extract rhs;
 158             Exp rhs = NOexp;
 159             match while (decl)
 160             {  REPLACEMENTdecl(exp2,_): { rhs = exp2; goto found; }
 161             |  MARKEDdecl(_,d):         { decl = d; }
 162             |  _:
 163                {  debug_msg("PE [%e has unknown action at %r]\n",redex,rule);
 164                   return UNKNOWN;
 165                }
 166             }
 167
 168             found:
 169             rhs = subst(rhs,0);
 170             replacement = simplify(rhs,redex);
 171             debug_msg("PE [%e => %e via %r]\n",redex,replacement,rule);
 172             return SUCCESS;
 173          }
 174       }
 175       try_next: ;
 176    }
 177    debug_msg("PE [%e fails all rules]\n",redex);
 178    return FAILURE;
 179 }
 180
 181 ///////////////////////////////////////////////////////////////////////////////
 182 //
 183 //  Class to simplify an expression
 184 //
 185 ///////////////////////////////////////////////////////////////////////////////
 186 rewrite class RedexSimplifier (Exp, Exps, Cons, Literal)
 187 {  Exp current_redex;
 188    Exp TRUE, FALSE;
 189 public:
 190    RedexSimplifier(Exp r)
 191       : current_redex(r),
 192         TRUE(LITERALexp(BOOLlit(true))),
 193         FALSE(LITERALexp(BOOLlit(false))) {}
 194 };
 195
 196 ///////////////////////////////////////////////////////////////////////////////
 197 //
 198 //  Redex simplifier
 199 //
 200 ///////////////////////////////////////////////////////////////////////////////
 201 datatype law TRUE  = LITERALexp(BOOLlit true)
 202            | FALSE = LITERALexp(BOOLlit false)
 203            | AND(a,b) = BINOPexp("&&",a,b)
 204            | OR(a,b)  = BINOPexp("||",a,b)
 205            | NOT a    = PREFIXexp("!",a)
 206            ;
 207
 208 rewrite RedexSimplifier
 209 {  MARKEDexp(_,e): e
 210 |  DOTexp(TUPLEexp es, id):   component_exp(es,id)
 211 |  DOTexp(RECORDexp les, id): component_exp(les,id)
 212 |  SELECTORexp(APPexp(IDexp id,e),ONEcons { name ...},_) | name == id: e
 213 |  EQexp(_,a,b) | equal(a,b): TRUE
 214 |  IDexp "redex": current_redex
 215 |  AND(TRUE,X):  X
 216 |  AND(X,TRUE):  X
 217 |  AND(FALSE,X): FALSE
 218 |  AND(X,FALSE): FALSE
 219 |  OR(TRUE,X):   TRUE
 220 |  OR(X,TRUE):   TRUE
 221 |  OR(FALSE,X):  X
 222 |  OR(X,FALSE):  X
 223 |  NOT(TRUE):    FALSE
 224 |  NOT(FALSE):   TRUE
 225 |  NOT(NOT X):   X
 226 };
 227
 228 ///////////////////////////////////////////////////////////////////////////////
 229 //
 230 //  Method to simplify an expression
 231 //
 232 ///////////////////////////////////////////////////////////////////////////////
 233 Exp RewriteMix::simplify (Exp exp, Exp redex)
 234 {  RedexSimplifier S(redex);
 235    debug_msg("PE [simplifying %e [redex = %e] => ", exp, redex);
 236    S(exp);
 237    debug_msg("%e]\n", exp);
 238    return exp;
 239 }
 240
 241 ///////////////////////////////////////////////////////////////////////////////
 242 //
 243 //  This is the main method for matching an expression against a pattern.
 244 //  If sucessful, the bindings for the pattern variables are returned
 245 //  in environment.  Matching can have one of 3 different results:
 246 //  (1) SUCCESS, in which case the match is successful,
 247 //  (2) FAILURE, in which case the match is not successful, or
 248 //  (3) UNKNOWN, if the result cannot be determined statically.
 249 //
 250 ///////////////////////////////////////////////////////////////////////////////
 251 Result RewriteMix::pmatch (Pat pat, Exp exp)
 252 {
 253    // Perform bindings and some simple simplifications.
 254    match while (pat)
 255    {  TYPEDpat(p, _):   { pat = p; }
 256    |  MARKEDpat(_, p):  { pat = p; }
 257    |  ASpat(id,p,ty,e): { pat = p; }
 258    |  WILDpat _:        { return SUCCESS; }
 259    |  IDpat(id, ty, e): { return SUCCESS; }
 260    }
 261
 262    // Match the expression against the pattern.
 263    match (pat) and (exp)
 264    {
 265      LITERALpat a, LITERALexp b:
 266      { return literal_equal(a,b) ? SUCCESS : FAILURE; }
 267    | TUPLEpat ps,   TUPLEexp es:   { return pmatch(ps,es); }
 268    | EXTUPLEpat ps, EXTUPLEexp es: { return pmatch(ps,es); }
 269    | RECORDpat (lps, _), RECORDexp les: { return pmatch(lps,les); }
 270    //| LISTpat { head, tail ... }, LISTexp (_,_,heade,taile):
 271    //  { return pmatch(head,tail,heade,taile,E,visible,plr); }
 272    | CONSpat ONEcons { name ... }, IDexp id:
 273      { return name == id ? SUCCESS : FAILURE; }
 274    | APPpat(CONSpat ONEcons { name ... }, p), APPexp(IDexp id,e)
 275         | find_cons(id) != NOcons:
 276      { if (name != id) return FAILURE;
 277        else return pmatch(p,e);
 278      }
 279    | APPpat(CONSpat _,_), IDexp id | find_cons(id) != NOcons:
 280      { return FAILURE; }
 281    | CONSpat _, APPexp(IDexp id,_) | find_cons(id) != NOcons:
 282      { return FAILURE; }
 283    | _:  { return UNKNOWN; }
 284    }
 285 }
 286
 287 ///////////////////////////////////////////////////////////////////////////////
 288 //
 289 //  Method to match an expression list against a pattern list.
 290 //
 291 ///////////////////////////////////////////////////////////////////////////////
 292 Result RewriteMix::pmatch (Pats pats, Exps exps)
 293 {  match while (pats) and (exps)
 294    {  #[a ... b], #[c ... d]:
 295       {  Result r = pmatch(a,c);
 296          if (r != SUCCESS) return r;
 297          pats = b; exps = d;
 298       }
 299    }
 300    return SUCCESS;
 301 }
 302
 303 ///////////////////////////////////////////////////////////////////////////////
 304 //
 305 //  Method to match a labeled expression list against a labeled pattern list.
 306 //
 307 ///////////////////////////////////////////////////////////////////////////////
 308 Result RewriteMix::pmatch (LabPats pats, LabExps exps)
 309 {  for_each (LabPat, p, pats)
 310    {  for_each (LabExp, e, exps)
 311       {  if (p.label == e.label)
 312          {  Result r = pmatch(p.pat,e.exp);
 313             if (r != SUCCESS) return r;
 314             goto NEXT;
 315          }
 316       }
 317       // not found:
 318       return FAILURE;
 319    NEXT: ;
 320    }
 321    return SUCCESS;
 322 }