prop-src/printgen.pcc.old

   1 ///////////////////////////////////////////////////////////////////////////////
   2 //  Pretty printing generator.
   3 ///////////////////////////////////////////////////////////////////////////////
   4 #include "ir.ph"
   5 #include "ast.ph"
   6 #include "type.h"
   7 #include "compiler.h"
   8 #include "datagen.h"
   9
  10 ///////////////////////////////////////////////////////////////////////////////
  11 //  Generate a pretty printer for a given type.
  12 ///////////////////////////////////////////////////////////////////////////////
  13 void DatatypeCompiler::gen_pretty_printer(Bool extern_def, Ty ty, Tys tys)
  14 {  match (deref_all(ty))
  15    {  ty as TYCONty(DATATYPEtycon { id, unit, arg, terms, qualifiers ... }, _):
  16       {  if (extern_def) {
  17             pr ("%^%/%^// Pretty printer for type %T%^%/"
  18                 "%^ostream& operator << (ostream&, %t);"
  19                 "%^ostream& pretty_print(ostream&, %t, int = 0, int = 0);\n\n",
  20                 ty, ty, "", ty, "");
  21          } else {
  22             pr ("%^%/%^// Pretty printer for type %T%^%/"
  23                 "%^ostream& pretty_print(ostream& _f_, %t, int _tab_, int _prec_)"
  24                 "%^{%+",
  25             ty, ty, "_x_");
  26
  27             int arity = unit + arg;
  28
  29             if (arity > 1) pr ("%^switch (%U(_x_)) {%+", ty);
  30
  31             for (int i = 0; i < arity; i++)
  32             {  match (terms[i])
  33                {  term as ONEcons { ty, name, print_formats, cons_ty ... }:
  34                   {  Ty t = ty == NOty ? NOty : apply_ty(cons_ty,tys);
  35                      if (arity > 1) pr ("%^case %*: %+", term, true);
  36                      if (print_formats != #[])
  37                         gen_formated_printer(term, t, print_formats);
  38                      else
  39                         gen_default_printer(term, t);
  40                      if (arity > 1) pr ("%^break;%-");
  41                   }
  42                |  _:
  43                }
  44             }
  45
  46             if (arity > 1) pr ("%-%^}");
  47             pr ("%^return _f_;%-"
  48                 "%^}\n\n");
  49
  50             pr ("%^ostream& operator << (ostream& _f_, %t)"
  51                 "%^{ return pretty_print(_f_,_x_); }\n\n",
  52                 ty, "_x_");
  53          }
  54       }
  55    |  _: // skip
  56    }
  57 }
  58 ///////////////////////////////////////////////////////////////////////////////
  59 //  Method to print one type component.
  60 ///////////////////////////////////////////////////////////////////////////////
  61 void make_printer (DatatypeCompiler& C, Ty ty, Exp e)
  62 {  match (deref_all(ty))
  63    {  TYCONty(ARRAYtycon (bound as ! NOexp),tys):
  64       {  C.pr ("%^{ int _i_;%+"
  65                "%^_f_ << '[';"
  66                "%^for (_i_ = 0; _i_ < %e; _i_++) {%+", bound);
  67          make_printer(C,tys->#1,INDEXexp(e,IDexp("_i_")));
  68          C.pr ("%^if (_i_ < %e - 1) _f_ << \", \";", bound);
  69          C.pr ("%-"
  70                "%^}"
  71                "%^_f_ << ']';"
  72                "%-%^}");
  73       }
  74    |  ty:
  75       {  if (has_qual(QUALprintable, ty)) {
  76             C.pr("%^pretty_print(_f_, %e, _tab_, _prec_);", e);
  77          } else {
  78             C.pr("%^_f_ << %e;", e);
  79          }
  80       }
  81    }
  82 }
  83
  84 ///////////////////////////////////////////////////////////////////////////////
  85 //  Generate a pretty printer according to the format string.
  86 ///////////////////////////////////////////////////////////////////////////////
  87 void DatatypeCompiler::gen_formated_printer(Cons term, Ty ty, PrintFormats fmt)
  88 {  Tys ty_list;
  89    Ids lab_list = #[];
  90
  91    match (deref_all(ty))
  92    {  NOty:                              { ty_list = #[]; }
  93    |  TYCONty(TUPLEtycon, tys):          { ty_list = tys; }
  94    |  TYCONty(RECORDtycon(labs,_), tys): { ty_list = tys; lab_list = labs; }
  95    |  ty:                                { ty_list = #[ ty ]; }
  96    }
  97
  98    int arity = length(ty_list);
  99    Tys tys   = ty_list;
 100    Ids labs  = lab_list;
 101    int index = 1;
 102
 103    Exp e = select(IDexp("_x_"), term);
 104
 105    for_each (PrintFormat, f, fmt)
 106    {  match (f)
 107       {  PFint i: // print the ith element
 108          {  if (lab_list != #[])
 109                error("%Lformat #%i used on constructor %s%T\n",
 110                      i, term->name, ty);
 111             int j; Tys t;
 112             for (t = ty_list, j = 1; t; t = t->#2, j++)
 113                if (j == i) {
 114                   make_printer(*this, t->#1, DOTexp(e,index_of(i))); break;
 115                }
 116             if (t == #[])
 117                error("%Lcomponent #%i not found in constructor %s%T\n",
 118                      i, term->name, ty);
 119          }
 120       |  PFlabel l: // print label l
 121          {  if (lab_list == #[])
 122                error("%Lformat #%s used on non-record constructor %s%T\n",
 123                      l, term->name, ty);
 124             Ids ls; Tys t;
 125             for (ls = lab_list, t = ty_list; ls && t; t = t->#2, ls = ls->#2)
 126                if (ls->#1 == l) {
 127                   make_printer(*this, t->#1, DOTexp(e,l)); break;
 128                }
 129             if (t == #[])
 130                error("%Lcomponent %s not found in constructor %s%T\n",
 131                      l, term->name, ty);
 132          }
 133       |  PFstring s:    {  pr ("%^_f_ << %s;", s); }
 134       |  PFspecial '_':
 135          {  if (tys == #[]) {
 136                error ("%Lillegal format '_' on constructor %s%T\n",
 137                       term->name, ty);
 138             } else {
 139                Exp exp;
 140                if (arity == 1 && labs == #[]) exp = e;
 141                else if (labs) exp = DOTexp(e,labs->#1);
 142                else exp = DOTexp(e,index_of(index));
 143                make_printer(*this, tys->#1, exp);
 144                tys = tys->#2;
 145                if (labs) labs = labs->#2;
 146                index++;
 147             }
 148          }
 149       |  PFspecial '{':
 150          {  pr ("%^_tab_ += 3;"
 151                 "%^_f_ << '\\n';"
 152                 "%^PrettyPrinter::print_tabs(_f_,_tab_);");
 153          }
 154       |  PFspecial '}':
 155          {  pr ("%^_tab_ -= 3;"
 156                 "%^_f_ << '\\n';"
 157                 "%^PrettyPrinter::print_tabs(_f_,_tab_);");
 158          }
 159       |  PFspecial '/':
 160          {  pr ("%^_f_ << '\\n';"
 161                 "%^PrettyPrinter::print_tabs(_f_,_tab_);");
 162          }
 163       |  PFspecial c:
 164          {  error ("%Lillegal print format '%c' in constructor %s%T\n",
 165                    (int)c, term->name, ty);
 166          }
 167       }
 168    }
 169 }
 170
 171 ///////////////////////////////////////////////////////////////////////////////
 172 //  Generate a pretty printer using the default format
 173 ///////////////////////////////////////////////////////////////////////////////
 174 void DatatypeCompiler::gen_default_printer(Cons term, Ty ty)
 175 {  if (term->name[0] == '"')
 176       pr ("%^_f_ << %s;", term->name);
 177    else
 178       pr ("%^_f_ << \"%s\";", term->name);
 179    Exp e = select(IDexp("_x_"), term);
 180    if (is_array_constructor(term->name))
 181       ty = TYCONty(ARRAYtycon(ARROWexp(IDexp("_x_"),"len()")), #[ty]);
 182    match (deref_all(ty))
 183    {  NOty:  // skip
 184    |  TYCONty(TUPLEtycon, tys):
 185       {  pr ("%^_f_ << '(';");
 186          int i = 1;
 187          for(Tys t = tys; t; t = t->#2)
 188          {  make_printer(*this, t->#1, DOTexp(e,index_of(i)));
 189             if (t->#2) pr ("%^_f_ << \", \";");
 190             i++;
 191          }
 192          pr ("%^_f_ << ')';");
 193       }
 194    |  TYCONty(RECORDtycon(labs,_), tys):
 195       {  pr ("%^_f_ << '{';");
 196          Ids l; Tys t;
 197          for(l = labs, t = tys; t; l = l->#2, t = t->#2)
 198          {  pr ("%^_f_ << \"%s = \";", l->#1);
 199             make_printer(*this, t->#1, DOTexp(e,l->#1));
 200             if (t->#2) pr ("%^_f_ << \", \";");
 201          }
 202          pr ("%^_f_ << '}';");
 203       }
 204    |  ty: {  pr ("%^_f_ << '(';");
 205              make_printer(*this, ty, e);
 206              pr ("%^_f_ << ')';");
 207           }
 208    }
 209 }