initial
[prop.git] / prop-src / codegen.pcc
blobae7aeea460652e3518f961a24740f6b9b0ca6784
1 ///////////////////////////////////////////////////////////////////////////////
2 //
3 //  This file implements the low level routine for generating C++ output->
4 //
5 ///////////////////////////////////////////////////////////////////////////////
6 #include <iostream.h>
7 #include <string.h>
8 #include <AD/strings/charesc.h>
9 #include "codegen.h"
10 #include "ir.ph"
11 #include "ast.ph"
12 #include "type.h"
13 #include "matchcom.h"
14 #include "options.h"
16 ///////////////////////////////////////////////////////////////////////////////
18 //  Code generator constructor and destructor
20 ///////////////////////////////////////////////////////////////////////////////
21 CodeGen:: CodeGen() 
22    : output(&cerr), anchored(true), tabbing(0), tab_unit(3) {}
23 CodeGen::~CodeGen() {}
24 void CodeGen::set_stream(ostream& s) { output = &s; }
26 ///////////////////////////////////////////////////////////////////////////////
28 //  Convert literals to a type string.
30 ///////////////////////////////////////////////////////////////////////////////
31 fun literal_type_of INTlit _: Id:               { return "integer"; }
32   | literal_type_of REALlit _:                  { return "real"; }
33   | literal_type_of CHARlit _:                  { return "character"; }
34   | literal_type_of BOOLlit _:                  { return "boolean"; }
35   | literal_type_of STRINGlit _ || REGEXPlit _: { return "string"; }
36   | literal_type_of QUARKlit _:                 { return "Quark"; }
37   | literal_type_of BIGINTlit _:                { return "BigInt"; }
38   ;
40 ///////////////////////////////////////////////////////////////////////////////
42 //  Emit a string with indenting.
44 ///////////////////////////////////////////////////////////////////////////////
45 void CodeGen::gen_code(const char * code)
46 {  const char * p, * q;
47    int line_no = 1;
48    int my_tab = -1;
49    for (p = code; *p; ) {
50       if (anchored) {
51          int t;
52          if (line_no == 2) {
53             if (tabbing == 0) my_tab = 0;
54             else for (my_tab = 0, q = p; *q == ' '; q++) my_tab++;
55          }
56          if (line_no >= 2) {
57             for (t = my_tab; *p == ' ' && t > 0; p++) t--;
58             for (t = tabbing; t > 0; t--) output->put(' ');
59          } else {
60             for (t = tabbing; *p == ' ' && t > 0; p++) t--;
61             for ( ; t > 0; t--) output->put(' ');
62          }
63       } else {
64          for ( ; *p == ' '; p++); output->put(' ');
65       }
66       anchored = false;
67       for (;;) {
68          if (*p == '\0') break;
69          output->put(*p);
70          if (*p == '\n') { line_no++; anchored = true; p++; break; }
71          p++;
72       } 
73    }
76 ///////////////////////////////////////////////////////////////////////////////
78 //  Decode a format string and dispatch to various printing routines.
80 ///////////////////////////////////////////////////////////////////////////////
81 ostream& CodeGen::outv(const char * fmt, va_list arg)
82 {  unsigned char c;
83    while ((c = *fmt++) != 0)
84    {  if (c == '%') {
85          switch (*fmt++) {
86             case 'i': (*output)<< va_arg(arg,int); anchored = false; break;
87             case 'c':  c = (unsigned char)va_arg(arg,int); 
88                        output->put(c); anchored = (c == '\n'); break;
89             case 'C':  gen_code(va_arg(arg,const char *)); break;
90             case 's':  { const char * s = va_arg(arg,const char *); 
91                          int len = strlen(s);
92                         (*output)<< s;
93                          anchored = (s[len-1] == '\n');
94                        } break;
95             case 'S': (*output)<< mangle(va_arg(arg,const char *));
96                        anchored = false;
97                        break;
98             case 'q': (*output)<< va_arg(arg,QualId); anchored = false; break;
99             case 'e': (*output)<< va_arg(arg,Exp); anchored = false; break;
100             case 'f': { Bool save = pretty_print_exp;
101                         pretty_print_exp = true;
102                         (*output)<< va_arg(arg,Exp); anchored = false; 
103                         pretty_print_exp = save;
104                       } break;
105             case 'E':  {  Exp e = va_arg(arg,Exp);
106                           match (e)
107                           {  MARKEDexp (loc,e): 
108                              { pr ("%D", MARKEDdecl(loc, EXPdecl(e))); }
109                           |  _: {(*output)<< e; }
110                           }
111                           anchored = false;
112                        }  break;
113             case 'l': (*output)<< va_arg(arg,Literal); anchored = false; break;
114             case 'p': (*output)<< va_arg(arg,Pat); anchored = false; break;
115             case 'r': (*output)<< va_arg(arg,MatchRule); anchored = false; break;
116             case 'b':  {  Ty        ty       = va_arg (arg,Ty);
117                           Id        name     = va_arg (arg,Id);
118                           Id        id       = mangle(name);
119                           Parameter p        = va_arg (arg,Parameter);
120                           Bool      is_array = is_array_constructor(name);
121                           if (is_array)
122                           {  Ty body_ty = NOty;
123                              if (p == TYbody)
124                              {  pr ("%^const int len_;%^");
125                                 body_ty = mkarrayty(ty,LITERALexp(INTlit(0)));
126                              } else
127                              {  body_ty = 
128                                   mkrecordty(
129                                   #[Id("_len_"), id],
130                                   #[integer_ty, mkptrty(QUALty(QUALconst,ty))],
131                                   false);
132                              }
133                              print_parameter(*output, body_ty, id, p);
134                              if (p == TYbody)
135                              {  pr ("\n"
136                                     "%^inline int len() const { return len_; }"
137                                     "%^inline %t const&  at(int i) const { return %S[i]; }"
138                                     "%^inline %t&        at(int i)       { return %S[i]; }"
139                                     "%^inline %t const * array() const   { return %S; }"
140                                     "%^inline %t *       array()         { return %S; }",
141                                     ty, "", name, ty, "", name,
142                                     ty, "", name, ty, "", name);
143                              }   
144                           } else {
145                              print_parameter(*output, ty, id, p);
146                           }
147                           anchored = false;
148                        }  break;
149             case 'T': (*output)<< va_arg(arg,Ty); anchored = false; break;
150             case 't':  {  Bool save = pretty_print_ty; 
151                           pretty_print_ty = false; 
152                           Ty ty = va_arg(arg,Ty); 
153                           ty_id = va_arg(arg,Id); 
154                          (*output)<< ty;
155                           anchored = false; 
156                           pretty_print_ty = save; 
157                        } break;
158             case 'V':  print_tyvars(*output,va_arg(arg,TyVars), '<', '>', false); 
159                        anchored = false; break;
160             case 'P':  {  Tys tys = va_arg(arg,Tys); 
161                           Bool save = pretty_print_ty; 
162                           pretty_print_ty = false; 
163                           if (tys)(*output)<< '<' << tys << '>';
164                           pretty_print_ty = save; 
165                           anchored = false; 
166                        } break;
167             case 'Q': (*output)<< va_arg(arg,Pid); anchored = false; break;
168             case 'H':  print_tyvars(*output,va_arg(arg,TyVars), '<', '>', true); 
169                        anchored = false; break;
170             case 'v':  print_tyvars(*output,va_arg(arg,TyVars), '(', ')', false); 
171                        anchored = false; break;
172             case '#':  {  int l          = va_arg(arg,int);
173                           const char * f = va_arg(arg,const char *);
174                           if (options.line_directives)
175                           {  if (! anchored)(*output)<< '\n';
176                             (*output)<< "#line " << l << " \"" << f << "\"\n";
177                              anchored = true;
178                           }
179                        }  break;
180             case '!':  {  const Loc * l = va_arg(arg, const Loc *);
181                           if (! anchored)(*output)<< '\n';
182                           if (options.GNU_style_message) 
183                             (*output)<< l->file_name << ':' 
184                                     << l->begin_line << ": ";
185                           else
186                             (*output)<< '"' << l->file_name << "\", line "
187                                     << l->begin_line << ": ";
188                           anchored = true;
189                        }  break;
190             case 'L':  if (options.GNU_style_message) 
191                          (*output)<< file << ':' << line << ": ";
192                        else
193                          (*output)<< '"' << file << "\", line " << line << ": ";
194                        anchored = false;
195                        break;
196             case 'w':  if (options.strict_checking) errors++;
197                        else(*output)<< "warning: ";
198                        anchored = false;
199                        break;
200             case 'M': (*output)<< va_arg(arg,Match); anchored = false; break;
201             case 'n':  if (! anchored)(*output)<< '\n'; anchored = true; break;
202             case 'I':  {  Inherits i = va_arg(arg,Inherits); 
203                          (*output)<< i;
204                           anchored = false;
205                        } break;
206             case 'U':  {  Exp exp = va_arg(arg,Exp);
207                           Ty  ty  = va_arg(arg,Ty);
208                           (*output) << MatchCompiler::untag(exp,ty);
209                        }  break;
210             case '*':  {  Cons cons = va_arg(arg,Cons);
211                           Bool normalized = va_arg(arg,Bool);
212                           (*output) << MatchCompiler::tag_name_of(cons,
213                              normalized);
214                        } break;
215             case '%': (*output)<< '%'; anchored = false; break;
216             case '?':  if (! anchored) break;
217             case '^':  { if (! anchored)(*output)<< '\n';
218                          if (tabbing < 0) error ("Tab = %i\n", tabbing);
219                          for (int i = tabbing; i > 0; i--)(*output)<< ' ';
220                          anchored = (tabbing == 0);
221                        } break;
222             case '+':  tabbing += tab_unit; break;
223             case '-':  tabbing -= tab_unit; break;
224             case '/':  { for (int i = 79 - tabbing; i > 0; i--)(*output)<< '/';
225                         (*output)<< '\n'; anchored = true;
226                        } break;
227             case '=': (*output)<< "_equal_" << literal_type_of(va_arg(arg,Literal)); break;
228             case '<': (*output)<< "_less_"  << literal_type_of(va_arg(arg,Literal)); break;
229             default:   arg = printer(fmt[-1],arg); break;
230          }
231       }
232       else { output->put(c); anchored = (c == '\n'); }
233    }
234    return *output;
237 ///////////////////////////////////////////////////////////////////////////////
239 //  Entry point.
241 ///////////////////////////////////////////////////////////////////////////////
242 ostream& CodeGen::pr(const char * fmt, ...)
243 {  va_list arg;
244    va_start(arg,fmt);
245    outv(fmt,arg);
246    va_end(arg);
247    return *output;