use typename
[prop.git] / prop-src / rwmix.pcc.old
blobd9e1cb156a827f253f3d8556810bfbb6eee03a02
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"
15 ///////////////////////////////////////////////////////////////////////////////
17 //  Type definitions
19 ///////////////////////////////////////////////////////////////////////////////
20 typedef RewriteMix::Result Result;
21 type sharing Bool = bool;
23 ///////////////////////////////////////////////////////////////////////////////
25 //  The constructors and destructors 
27 ///////////////////////////////////////////////////////////////////////////////
28 RewriteMix::RewriteMix() { reduction_limit = 10; }
29 RewriteMix::~RewriteMix() {}
31 ///////////////////////////////////////////////////////////////////////////////
33 //  Method to optimize a set of rewrite rules
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;
45 ///////////////////////////////////////////////////////////////////////////////
47 //  Method to partially evaluate a set of rules
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;
77 ///////////////////////////////////////////////////////////////////////////////
79 //  Method to normalizes an expression with respect to a set
80 //  of rewrite rules.
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;
121 ///////////////////////////////////////////////////////////////////////////////
123 //  Method to match an expression against a set of rules.
125 ///////////////////////////////////////////////////////////////////////////////
126 Result RewriteMix::reduce (Exp redex, MatchRules rules, Exp& replacement)
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             }
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;
181 ///////////////////////////////////////////////////////////////////////////////
183 //  Class to simplify an expression 
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))) {}
196 ///////////////////////////////////////////////////////////////////////////////
198 //  Redex simplifier
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            ;
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
228 ///////////////////////////////////////////////////////////////////////////////
230 //  Method to simplify an expression 
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;
241 ///////////////////////////////////////////////////////////////////////////////
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.
250 ///////////////////////////////////////////////////////////////////////////////
251 Result RewriteMix::pmatch (Pat pat, Exp exp) 
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    }
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    }
287 ///////////////////////////////////////////////////////////////////////////////
289 //  Method to match an expression list against a pattern list.
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; 
303 ///////////////////////////////////////////////////////////////////////////////
305 //  Method to match a labeled expression list against a labeled pattern list.
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;