prop-src/rwgen5.pcc

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements indexing for rewriters
   4 //
   5 ///////////////////////////////////////////////////////////////////////////////
   6 #include "basics.ph"
   7 #include "hashtab.h"
   8 #include "rwgen.h"
   9 #include "funmap.h"
  10 #include "type.h"
  11 #include "options.h"
  12
  13 ///////////////////////////////////////////////////////////////////////////////
  14 //
  15 //  Indexing class
  16 //
  17 ///////////////////////////////////////////////////////////////////////////////
  18 RewriteIndexing::RewriteIndexing(Ty t, Id i, Bool e)
  19    : ty(t), name(i), external(e) {}
  20 RewriteIndexing::~RewriteIndexing() {}
  21
  22 ///////////////////////////////////////////////////////////////////////////////
  23 //
  24 //  Mapping from id to RewriteClass
  25 //
  26 ///////////////////////////////////////////////////////////////////////////////
  27 HashTable RewritingCompiler::rewrite_classes(string_hash, string_equal);
  28
  29 ///////////////////////////////////////////////////////////////////////////////
  30 //
  31 //  Enter a rewrite class
  32 //
  33 ///////////////////////////////////////////////////////////////////////////////
  34 void RewritingCompiler::add_rewrite_class(RewriteClass * C)
  35 {  if (rewrite_classes.contains(C->class_name)) {
  36       error ("%Lrewrite class %s has already been defined\n", C->class_name);
  37    } else {
  38       rewrite_classes.insert(C->class_name, C);
  39       debug_msg ("[Rewriting class %s declared]\n", C->class_name);
  40    }
  41 }
  42
  43 ///////////////////////////////////////////////////////////////////////////////
  44 //
  45 //  Lookup a rewrite class
  46 //
  47 ///////////////////////////////////////////////////////////////////////////////
  48 RewriteClass * RewritingCompiler::lookup_rewrite_class(Id id)
  49 {  HashTable::Entry * e = rewrite_classes.lookup(id);
  50    if (e == 0) {
  51       error ("%Lrewrite class %s is undefined\n", id);
  52       return 0;
  53    } else {
  54       return (RewriteClass *)rewrite_classes.value(e);
  55    }
  56 }
  57
  58 Protocols RewritingCompiler::lookup_protocols(Id id)
  59 {  RewriteClass * C = lookup_rewrite_class(id);
  60    return C ? C->protocols : #[];
  61 }
  62
  63 TyQual RewritingCompiler::lookup_qual(Id id)
  64 {  RewriteClass * C = lookup_rewrite_class(id);
  65    return C ? C->qualifiers : QUALnone;
  66 }
  67
  68 ///////////////////////////////////////////////////////////////////////////////
  69 //
  70 //  Method to retrieve the indexing information for a type
  71 //
  72 ///////////////////////////////////////////////////////////////////////////////
  73 const RewriteIndexing * RewritingCompiler::get_index(Ty ty) const
  74 {  for_each (RewriteIndexing *, i, indices)
  75    {  if (ty_equal(i->ty, ty)) return i;
  76    }
  77    return 0;
  78 }
  79
  80 ///////////////////////////////////////////////////////////////////////////////
  81 //
  82 //  Method to compute the index
  83 //
  84 ///////////////////////////////////////////////////////////////////////////////
  85 Bool RewritingCompiler::compute_index (Ty ty, Id& name, Bool& external) const
  86 {  Ty datatype_ty            = deref_all(ty);
  87    Bool is_boxed             = boxed_variants(datatype_ty) > 0;
  88    Bool rewritable           = has_qual(QUALrewritable, datatype_ty);
  89    const RewriteIndexing * I = get_index(ty);
  90    Bool need_cache           = Fmap->has_replacement || Fmap->gen_reducers;
  91
  92    Bool ok = is_boxed && (rewritable || I != 0) && need_cache;
  93
  94    if (I != 0 && I->name == #"none") ok = false;
  95
  96    if (ok)
  97    {  if (I) { name = I->name; external = I->external; }
  98       else   { name = "rewrite"; external = false; }
  99       return true;
 100    } else
 101       return false;
 102 }
 103
 104 ///////////////////////////////////////////////////////////////////////////////
 105 //
 106 //  Method to check whether a type has an index
 107 //
 108 ///////////////////////////////////////////////////////////////////////////////
 109 Bool RewritingCompiler::has_index (Ty ty) const
 110 {  Id name; Bool external;
 111    return compute_index(ty,name,external);
 112 }
 113
 114 ///////////////////////////////////////////////////////////////////////////////
 115 //
 116 //  Method to emit code for retrieving the state from an expression
 117 //
 118 ///////////////////////////////////////////////////////////////////////////////
 119 Id RewritingCompiler::gen_get_rewrite_state(Ty ty, Exp pat_exp)
 120 {  Id name; Bool external;
 121    if (! compute_index(ty,name,external))
 122    {  bug("%Lexpression %e : %T has no index", pat_exp, ty); }
 123    int units = unboxed_variants(ty);
 124    int args  = boxed_variants(ty);
 125    Functor f = Fmap->type_map[ty];
 126    Id state_var = vars.new_label();
 127
 128    if (units == 0)
 129    {  pr("%^int %s = ", state_var);
 130       if (external) pr("get_%s_state(%e);", name, pat_exp);
 131       else          pr("%e->get_%s_state();", pat_exp, name);
 132    } else if (args == 0)
 133    {  pr("%^int %s = %e + %i;", state_var, pat_exp, f);
 134    } else
 135    {  Id pat_var = vars.new_label();
 136       pr("%^%t %s = %e;"
 137          "%^int %s = boxed(%s) ? ",
 138          ty, "", pat_var, pat_exp, state_var, pat_var);
 139       if (external) pr("get_%s_state(%s)", name, pat_var);
 140       else          pr("%s->get_%s_state()", pat_var, name);
 141       pr(" : ((int)%s + %i);", pat_var, f);
 142    }
 143    return state_var;
 144 }
 145
 146 ///////////////////////////////////////////////////////////////////////////////
 147 //
 148 //  Method to emit code for retrieving the state from index
 149 //
 150 ///////////////////////////////////////////////////////////////////////////////
 151 void RewritingCompiler::gen_get_rewrite_state(Ty ty, Id redex)
 152 {  Id name; Bool external;
 153    if (! compute_index(ty,name,external)) return;
 154    if (external)
 155    {  pr("%^int cached__;"
 156          "%^if (r__ && boxed(redex) && (cached__ = get_%s_state(%s)) != BURS::undefined_state)"
 157          "%^{ s__ = cached__; return%s; }",
 158          name, redex, (Fmap->is_applicative ? " redex" : ""));
 159    } else
 160    {  pr("%^int cached__;"
 161          "%^if (r__ && boxed(redex) && (cached__ = %s->get_%s_state()) != BURS::undefined_state)"
 162          "%^{ s__ = cached__; return%s; }",
 163          redex, name, (Fmap->is_applicative ? " redex" : ""));
 164    }
 165 }
 166
 167 ///////////////////////////////////////////////////////////////////////////////
 168 //
 169 //  Method to emit code for setting the index state
 170 //
 171 ///////////////////////////////////////////////////////////////////////////////
 172 void RewritingCompiler::gen_set_rewrite_state_and_rule(Ty ty, Id redex)
 173 {  Id name; Bool external;
 174    if (! compute_index(ty,name,external)) return;
 175    if (external)
 176    {  pr("%^if (boxed(redex)) {%+"
 177          "%^set_%s_state(%s,s__);",name,redex);
 178       if (Fmap->gen_reducers)
 179          pr("%^set_%s_rule(%s,rule__);",name,redex);
 180       pr("%-%^}");
 181    } else
 182    {  pr("%^if (boxed(redex)) {%+"
 183          "%^%s->set_%s_state(s__);",redex,name);
 184       if (Fmap->gen_reducers)
 185          pr("%^%s->set_%s_rule(rule__);",redex,name);
 186       pr("%-%^}");
 187    }
 188 }
 189
 190 ///////////////////////////////////////////////////////////////////////////////
 191 //
 192 //  Method to emit code for retrieving the cached rule
 193 //
 194 ///////////////////////////////////////////////////////////////////////////////
 195 void RewritingCompiler::gen_get_rewrite_rule(Ty ty, Id redex)
 196 {  Id name; Bool external;
 197    if (! compute_index(ty,name,external))
 198    {  error("%Ltype %T is no index defined in treeparser mode rewrite class %s\n",
 199             ty, Fmap->class_name);
 200       return;
 201    }
 202    if (external)
 203    {  pr("get_%s_rule(%s)", name, redex);
 204    } else
 205    {  pr("%s->get_%s_rule()", redex, name);
 206    }
 207 }