prop-src/rwgen2.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements the 'rewrite (x) { ... }' construct.
   4 //  We'll transform this construct into the equivalent 'rewrite class ...'
   5 //  and 'rewrite id { ... };' statements.
   6 //
   7 ///////////////////////////////////////////////////////////////////////////////
   8 #include <iostream>
   9 #include "ir.ph"
  10 #include "ast.ph"
  11 #include "type.h"
  12 #include "rwgen.h"
  13 #include "options.h"
  14
  15 ///////////////////////////////////////////////////////////////////////////////
  16 //
  17 //   Method for compiling a 'rewrite (x) { ... }' statement.
  18 //
  19 ///////////////////////////////////////////////////////////////////////////////
  20 void RewritingCompiler::gen_rewriting
  21    ( Protocols        protocols,
  22      Exp              exp,
  23      Exp              dest,
  24      RewriteIndexings Is,
  25      MatchRules       rules,
  26      TyQual           qualifiers
  27    )
  28 {  MEM::use_global_pools();
  29    Id rewriter_name = Quark(options.mangled_file_prefix,vars.new_label());
  30    Ty exp_ty        = NOty;
  31    Ty ret_ty        = NOty;
  32    TyQual qual =
  33       (qualifiers & ~QUALapplicative) |
  34       (dest == NOexp ? QUALnone : QUALapplicative);
  35
  36    // Get the return and argument types
  37    match (protocols) and (dest)
  38    {  #[PROTOCOL{ ty ... } ... _], NOexp: { exp_ty = ty; ret_ty = void_ty; }
  39    |  #[PROTOCOL{ ty ... } ... _], dest:  { exp_ty = ret_ty = ty; }
  40    |  _: { error("%Lempty type list in rewrite (...) ..."); }
  41    }
  42
  43    // If it is destructive, use call by reference
  44    if (! (qual & QUALapplicative)) exp_ty = mkrefty(exp_ty);
  45
  46    // Print the interface to the auxiliary function
  47    pr("%+%^extern %t %s_rewrite(%t);", ret_ty, "", rewriter_name, exp_ty, "");
  48
  49    // Generate the rewriting call
  50    match (dest)
  51    {  NOexp: { pr("%^%s_rewrite(%e);", rewriter_name, exp); }
  52    |  dest:  { pr("%^%e = %s_rewrite(%e);", dest, rewriter_name, exp); }
  53    }
  54
  55    pr("%-");
  56
  57    // Add to the list of outstanding rewriting classes
  58    Decl   body = OPAQUEdecl(
  59        #"\npublic:\n   inline " + rewriter_name + #"() {}\n");
  60    Decl new_def =
  61       CLASSDEFdecl(new RewriteClass(rewriter_name,protocols,#[],qual,#[body]));
  62    rewriters = #[new_def,REWRITEdecl(rewriter_name, Is, rules) ... rewriters];
  63    MEM::use_local_pools();
  64 }
  65
  66 ///////////////////////////////////////////////////////////////////////////////
  67 //
  68 //  Method for compiling rewrite classes for the 'rewrite (...) { ... }'
  69 //  construct.
  70 //
  71 ///////////////////////////////////////////////////////////////////////////////
  72 void RewritingCompiler::gen_rewriters()
  73 {
  74    debug_msg("[Generating the rewriters in this file]\n");
  75    for_each (Decl, d, rewriters)
  76    {  pr ("%D", d);
  77       match (d)
  78       {  CLASSDEFdecl (a_class) |
  79             a_class->class_type == ClassDefinition::REWRITE_CLASS &&
  80             a_class->protocols:
  81          {  Id id       = a_class->class_name;
  82             Ty ty       = a_class->protocols->#1->ty;
  83             TyQual qual = a_class->qualifiers;
  84             // If it is destructive, use call by reference
  85             Bool is_applicative = qual & QUALapplicative;
  86             Bool do_traversal   = qual & QUALtreeparser;
  87             Ty exp_ty = is_applicative ? ty : mkrefty(ty);
  88             Ty ret_ty = is_applicative ? ty : void_ty;
  89
  90             // protocol
  91             pr ("%^%t %s_rewrite(%t _x_) ", ret_ty, "", id, exp_ty, "");
  92             // declare the rewriter
  93             pr ("%^{  %s _r_;", id);
  94             // call the labeler
  95             if (do_traversal)
  96             {  if (is_applicative)
  97                {  pr ("%^   return _r_.reduce(_r_(_x_));"); }
  98                else
  99                {  pr ("%^   _r_(_x_); %s_r_.reduce(_x_);",
 100                       ret_ty == void_ty ? "" : "return ");
 101                }
 102             } else
 103             {  if (is_applicative)
 104                {  pr ("%^   return _r_(_x_);"); }
 105                else
 106                {  pr ("%^   _r_(_x_);"); }
 107             }
 108             pr ("%^}\n\n");
 109          }
 110       |  _: // skip
 111       }
 112    }
 113    debug_msg("[Finished generating the rewriters in this file]\n");
 114 }