app/willard/phase3.pcc

   1 #include <AD/pretty/postream.h>
   2 #include "phase3.ph"
   3 #include "list.ph"
   4
   5 ///////////////////////////////////////////////////////////////////////////////
   6 //
   7 //  Constructors and destructors for phase3
   8 //
   9 ///////////////////////////////////////////////////////////////////////////////
  10 Phase3::Phase3() {}
  11 Phase3::~Phase3() {}
  12
  13 ///////////////////////////////////////////////////////////////////////////////
  14 //
  15 //  Methods to invoke phase3
  16 //
  17 ///////////////////////////////////////////////////////////////////////////////
  18 Exp Phase3::phase3(Exp e)
  19 {  message("Disjunction removal phase", e); (*this)(e); return e; }
  20
  21 ///////////////////////////////////////////////////////////////////////////////
  22 //
  23 //  Transformations to change disjunctions into unions
  24 //
  25 ///////////////////////////////////////////////////////////////////////////////
  26 rewrite Phase3
  27 {
  28
  29    // Flatten set comprehensions
  30 preorder:
  31    GENERATOR(x,A,GENERATOR(y,B,C)): GENERATOR(append(x,y),append(A,B),C)
  32
  33 bottomup:
  34
  35    // Flatten disjunctions
  36 |  Or(a,OP("or",b)):  OP("or",#[a ... b])
  37
  38    // The following rules transform disjunction into unions
  39 |  GENERATOR(x,A,GUARD(OP("or", es),e)):
  40    {  Ids  xs   = #[];
  41       Exps Qs   = #[];
  42       Exps exps = #[];
  43       Exps disjuncts = es;
  44       match while (disjuncts) of
  45          #[h ... t]:
  46          {  Id Q = gensym();
  47             xs   = #[ Q ... xs ];
  48             Qs   = #[ GENERATOR(x,A,GUARD(h,e)) ... Qs];
  49             exps = #[ ID(Q) ... exps ];
  50             disjuncts = t;
  51          }
  52       end match;
  53       rewrite(make_let(xs,Qs,OP("union",exps)));
  54    }
  55
  56    // Flatten lets
  57 |  LET(x,LET(y,b,a),e):  LET(y,b,LET(x,a,e))
  58 };