00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include <basix/list.hpp>
00014 #include <basix/literal.hpp>
00015 #include <basix/compound.hpp>
00016 #include <basix/mmx_syntax.hpp>
00017 #include <basix/math_syntax.hpp>
00018 namespace mmx {
00019
00020 #define DATA_BEGIN ((char) 2)
00021 #define DATA_END ((char) 5)
00022
00023 bool mmx_abbreviate_coerce= true;
00024
00025
00026
00027
00028
00029 class mmx_printer {
00030 MMX_ALLOCATORS
00031 private:
00032 list<generic> gl;
00033
00034 private:
00035 generic pp_verb (const string& s);
00036 generic pp_spc ();
00037 generic pp_lf ();
00038 generic pp_sep (bool large);
00039
00040 generic pp_C0 (const generic& g, bool large= false);
00041 generic pp_Conds (const generic& conds);
00042
00043 generic pp_where (const generic& g);
00044 generic pp_E0s (const generic& g, nat start);
00045
00046 generic pp_E1 (const generic& g);
00047 generic pp_E2 (const generic& g);
00048 generic pp_Lflux (const generic& g);
00049 generic pp_Rflux (const generic& g);
00050
00051 generic pp_F0 (const generic& g);
00052 generic pp_Seqors (const generic& g);
00053 generic pp_Ors (const generic& g);
00054 generic pp_Xors (const generic& g);
00055 generic pp_F1 (const generic& g);
00056 generic pp_Seqands (const generic& g);
00057 generic pp_Ands (const generic& g);
00058 generic pp_F2 (const generic& g);
00059 generic pp_F3 (const generic& g);
00060
00061 generic pp_T0 (const generic& g);
00062 generic pp_T1 (const generic& g);
00063 generic pp_T2 (const generic& g);
00064 generic pp_T3 (const generic& g);
00065 generic pp_T4 (const generic& g);
00066 generic pp_T5 (const generic& g);
00067
00068 generic pp_R0 (const generic& g);
00069 generic pp_R1 (const generic& g);
00070 generic pp_R2 (const generic& g);
00071 generic pp_R3 (const generic& g);
00072
00073 public:
00074 inline mmx_printer () {}
00075 inline ~mmx_printer () {}
00076
00077 generic pp_E0 (const generic& g);
00078 friend generic print_mmx (const generic& g);
00079 };
00080
00081
00082
00083
00084
00085 enum print_controls { LF, INDENT, VARINDENT, UNINDENT };
00086
00087 static nat indentation_level= 0;
00088
00089 static string&
00090 operator << (string& out, print_controls pc) {
00091 switch (pc) {
00092 case LF:
00093 out << "\n";
00094 for (nat i=0; i<indentation_level; i++) out << " ";
00095 break;
00096 case INDENT:
00097 indentation_level++;
00098 out << " ";
00099 break;
00100 case VARINDENT:
00101 indentation_level++;
00102 break;
00103 case UNINDENT:
00104 indentation_level--;
00105 if (N(out) >= 2 && out[N(out)-2] == ' ' && out[N(out)-1] == ' ')
00106 inside (out) -> resize (N(out) - 2);
00107 break;
00108 }
00109 return out;
00110 }
00111
00112
00113
00114
00115
00116 inline generic concat (const vector<generic>& v) {
00117 return gen ("$concat", v); }
00118 inline generic concat () {
00119 return gen ("$concat"); }
00120 inline generic concat (const generic& g1, const generic& g2) {
00121 return gen ("$concat", g1, g2); }
00122 inline generic concat (const generic& g1, const generic& g2,
00123 const generic& g3) {
00124 return gen ("$concat", g1, g2, g3); }
00125 inline generic concat (const generic& g1, const generic& g2,
00126 const generic& g3, const generic& g4) {
00127 return gen ("$concat", g1, g2, g3, g4); }
00128
00129 inline generic infix (const generic& g, const generic& op, const generic& h) {
00130 return gen ("$infix", g, op, h); }
00131 inline generic bigop (const generic& op, const vector<generic>& v) {
00132 return gen ("$bigop", cons (op, v)); }
00133 inline generic bracket (const generic& l, const generic& g, const generic& r) {
00134 return gen ("$bracket", l, g, r); }
00135 inline generic postfix (const generic& g, const generic& op) {
00136 return gen ("$postfix", g, op); }
00137 inline generic prefix (const generic& op, const generic& g) {
00138 return gen ("$prefix", op, g); }
00139 inline generic operate (const generic& g, const generic& h) {
00140 return gen ("$operate", g, h); }
00141 inline generic keyword (const generic& g) {
00142 return gen ("$keyword", g); }
00143 inline generic keyword (const generic& op, const generic& g) {
00144 return gen ("$keyword", op, g); }
00145 inline generic hlist (const vector<generic>& v) {
00146 return gen ("$hlist", v); }
00147 inline generic vlist (const vector<generic>& v) {
00148 return gen ("$vlist", v); }
00149 inline generic indented (const vector<generic>& v) {
00150 return gen ("$indent", v); }
00151
00152 static inline void
00153 init (table<generic,generic>& t, const generic& key, const generic& val) {
00154 t[key]= val;
00155 }
00156
00157 static table<generic,generic>
00158 mmx_symbol_table () {
00159 table<generic,generic> t;
00160 init (t, "mathcatalan", "K");
00161 init (t, "partial", "d");
00162 init (t, "derivative", "D");
00163 init (t, "matheuler", "gamma");
00164 init (t, "mathd", "d");
00165 init (t, "mathe", "e");
00166 init (t, "mathi", "i");
00167 init (t, "mathpi", "pi");
00168 return t;
00169 }
00170
00171 static void
00172 serialize (string& s, const generic& g) {
00173 if (is<literal> (g)) {
00174 static table<generic,generic> t= mmx_symbol_table ();
00175 if (contains (t, g)) s << literal_to_string (t[g]);
00176 else if (g == "$spc") s << " ";
00177 else if (g == "$lf") s << LF;
00178 else if (g == "$cr");
00179 else s << literal_to_string (g);
00180 }
00181 else if (is_func (g, "$concat") ||
00182 is_func (g, "$bracket") ||
00183 is_func (g, "$prefix") ||
00184 is_func (g, "$postfix"))
00185 for (nat i=1; i<N(g); i++)
00186 serialize (s, g[i]);
00187 else if (is_func (g, "$infix", 3)) {
00188 serialize (s, g[1]);
00189 if (g[2] != "^" && g[2] != "^^") s << " ";
00190 serialize (s, g[2]);
00191 if (g[2] != "^" && g[2] != "^^") s << " ";
00192 serialize (s, g[3]);
00193 }
00194 else if (is_func (g, "$bigop") && N(g) >= 3) {
00195 if (g[1] == GEN_PLUS && is_func (g[2], GEN_MINUS, 1)) {
00196 s << "-";
00197 serialize (s, g[2][1]);
00198 }
00199 else serialize (s, g[2]);
00200 for (nat i=3; i<N(g); i++) {
00201 if (g[1] == GEN_PLUS && is_func (g[i], GEN_MINUS, 1)) {
00202 s << " " << "-" << " ";
00203 serialize (s, g[i][1]);
00204 }
00205 else {
00206 s << " ";
00207 serialize (s, g[1]);
00208 s << " ";
00209 serialize (s, g[i]);
00210 }
00211 }
00212 }
00213 else if (is_func (g, "$keyword", 1))
00214 serialize (s, g[1]);
00215 else if (is_func (g, "$operate", 2) ||
00216 is_func (g, "$keyword", 2)) {
00217 serialize (s, g[1]);
00218 s << " ";
00219 serialize (s, g[2]);
00220 }
00221 else if (is_func (g, "$hlist") ||
00222 is_func (g, "$vlist")) {
00223 if (N(g) == 1) return;
00224 serialize (s, g[1]);
00225 for (nat i=2; i<N(g); i++) {
00226 if (g[0] == "$hlist") s << ", ";
00227 else s << "; ";
00228 serialize (s, g[i]);
00229 }
00230 }
00231 else if (is_func (g, "$indent")) {
00232 s << INDENT;
00233 for (nat i=1; i<N(g); i++)
00234 serialize (s, g[i]);
00235 s << UNINDENT;
00236 }
00237 else if (is_func (g, "$varindent")) {
00238 serialize (s, g[1]);
00239 s << VARINDENT;
00240 for (nat i=2; i<N(g); i++)
00241 serialize (s, g[i]);
00242 s << UNINDENT;
00243 }
00244 else if (is_func (g, "$text", 1))
00245 serialize (s, g[1]);
00246 else if (is_func (g, "$math", 1))
00247 serialize (s, g[1]);
00248 else if (is_func (g, "$dynamic", 2)) {
00249 s << "< ";
00250 serialize (s, g[1]);
00251 s << " | ";
00252 serialize (s, g[2]);
00253 s << " >";
00254 }
00255 else if (is<compound> (g) && is<literal> (g[0]) &&
00256 starts (as_string (as<literal> (g[0])), "tm$")) {
00257 generic h= texmacs_expand (g);
00258 serialize (s, h);
00259 }
00260 else {
00261 serialize (s, g[0]);
00262 s << " (";
00263 for (nat i=1; i<N(g); i++) {
00264 if (i != 1) s << ", ";
00265 serialize (s, g[i]);
00266 }
00267 s << ")";
00268 }
00269 }
00270
00271 static string
00272 serialize (const generic& g) {
00273 string s;
00274 serialize (s, g);
00275 return s;
00276 }
00277
00278
00279
00280
00281
00282 generic
00283 mmx_printer::pp_verb (const string& s) {
00284 return generic (s);
00285 }
00286
00287 generic
00288 mmx_printer::pp_spc () {
00289 return generic ("$spc");
00290 }
00291
00292 generic
00293 mmx_printer::pp_lf () {
00294 return generic ("$lf");
00295 }
00296
00297 generic
00298 mmx_printer::pp_sep (bool large) {
00299 if (large) return concat (pp_verb (";"), pp_lf ());
00300 else return concat ();
00301 }
00302
00303
00304
00305
00306
00307 static bool
00308 is_C0 (const generic& g) {
00309 if (is_func (g, GEN_BEGIN) ||
00310 is_func (g, GEN_IF) ||
00311 is_func (g, GEN_LOOP) ||
00312 is_func (g, GEN_BREAK) ||
00313 is_func (g, GEN_CONTINUE) ||
00314 is_func (g, GEN_TRY) ||
00315 is_func (g, GEN_LAMBDA) ||
00316 is_func (g, GEN_MACRO) ||
00317 is_func (g, GEN_RETURN) ||
00318 is_func (g, GEN_CLASS) ||
00319 is_func (g, GEN_MODULE) ||
00320 is_func (g, GEN_CATEGORY))
00321 return true;
00322 if (N(g) == 2 && is_C0 (g[1]))
00323 return
00324 is_func (g, GEN_AUTOFOLD) ||
00325 is_func (g, GEN_INLINE) ||
00326 is_func (g, GEN_INTERN) ||
00327 is_func (g, GEN_METHOD) ||
00328 is_func (g, GEN_EXTERN) ||
00329 is_func (g, GEN_MUTABLE) ||
00330 is_func (g, GEN_CONSTANT) ||
00331 is_func (g, GEN_OUTLINE) ||
00332 is_func (g, GEN_PUBLIC) ||
00333 is_func (g, GEN_PRIVATE);
00334 if (N(g) == 3 && is_C0 (g[2]))
00335 return
00336 is_func (g, GEN_FORALL) ||
00337 is_func (g, GEN_EXISTS) ||
00338 is_func (g, GEN_ASSUME) ||
00339 is_func (g, GEN_PENALTY) ||
00340 is_func (g, GEN_DEFINE) ||
00341 is_func (g, GEN_ASSIGN) ||
00342 is_func (g, GEN_DEFINE_MACRO) ||
00343 is_func (g, GEN_ASSIGN_MACRO) ||
00344 is_func (g, GEN_PLUS_ASSIGN) ||
00345 is_func (g, GEN_MINUS_ASSIGN) ||
00346 is_func (g, GEN_TIMES_ASSIGN) ||
00347 is_func (g, GEN_OVER_ASSIGN) ||
00348 is_func (g, GEN_LESSLESSEQ) ||
00349 is_func (g, GEN_GTRGTREQ);
00350 if (N(g) == 4 && is_C0 (g[3]))
00351 return
00352 is_func (g, GEN_FOREIGN);
00353 return false;
00354 }
00355
00356 static bool
00357 is_applicable (const generic& g) {
00358 if (is<literal> (g)) {
00359 const string s= literal_to_string (g);
00360 if (N(s)==0) return false;
00361 for (nat i=0; i<N(s); i++)
00362 if (s[i] == '.') {
00363 if (i != 0 || N(s) == 1) return false; }
00364 else if (((s[i]<'0') || (s[i]>'9')) &&
00365 ((s[i]<'a') || (s[i]>'z')) &&
00366 ((s[i]<'A') || (s[i]>'Z')) &&
00367 ((s[i]!='_') && (s[i]!='?') && (s[i]!='$')))
00368 return false;
00369 else if (s[i] == '$') return true;
00370 }
00371 return
00372 g != GEN_SEQAND && g != GEN_SEQOR && g != GEN_XOR &&
00373 g != GEN_LAMBDA && g != GEN_MACRO &&
00374 g != GEN_COERCE && g != GEN_COERCE_TYPE;
00375 }
00376
00377
00378
00379
00380
00381 static generic
00382 un_try_catch (const generic& g) {
00383 vector<generic> v;
00384 if (is_func (g[1], GEN_BEGIN)) v << cdr (compound_to_vector (g[1]));
00385 else v << g[1];
00386 for (nat i=2; i<N(g); i++) v << g[i];
00387 return gen (g[0], gen (GEN_BEGIN, v));
00388 }
00389
00390 generic
00391 mmx_printer::pp_C0 (const generic& g, bool large) {
00392 if (is_func (g, GEN_BEGIN)) {
00393 vector<generic> v;
00394 if (N(g) == 1)
00395 v << pp_verb ("{") << pp_verb ("}");
00396 else {
00397 vector<generic> w;
00398 v << pp_verb ("{") << pp_lf ();
00399 for (nat i=1; i<N(g); i++)
00400 w << pp_C0 (g[i], true);
00401 v << indented (w);
00402 v << pp_verb ("}");
00403 }
00404 if (large) v << pp_lf ();
00405 return concat (v);
00406 }
00407 else if (is_func (g, GEN_IF, 2)) {
00408 generic t= g[2];
00409 if (is_func (g[2], GEN_IF)) t= gen (GEN_BEGIN, g[2]);
00410 return concat (keyword ("if", pp_E0 (g[1])),
00411 pp_spc (),
00412 keyword ("then", pp_C0 (t, large)));
00413 }
00414 else if (is_func (g, GEN_IF, 3)) {
00415 generic t= g[2];
00416 if (is_func (g[2], GEN_IF)) t= gen (GEN_BEGIN, g[2]);
00417 bool large2= is_C0 (t);
00418 return concat (vec (keyword ("if", pp_E0 (g[1])),
00419 pp_spc (),
00420 keyword ("then", pp_C0 (t, large2)),
00421 large2? concat (): pp_spc (),
00422 keyword ("else", pp_C0 (g[3], large))));
00423 }
00424 else if (is_func (g, GEN_MATCH)) {
00425 generic b= cons (GEN_BEGIN, cdr (cdr (g)));
00426 return concat (keyword ("match", pp_E0 (g[1])),
00427 pp_spc (),
00428 keyword ("with", pp_C0 (b, large)));
00429 }
00430 else if (is_func (g, GEN_CASE) && N(g) >= 3) {
00431 vector<generic> v;
00432 for (nat i=2; i<N(g); i++)
00433 v << pp_E1 (g[i]);
00434 return concat (keyword ("case", hlist (v)),
00435 pp_spc (),
00436 keyword ("do", pp_C0 (g[1], large)));
00437 }
00438 else if (is_func (g, GEN_LOOP))
00439 return concat (pp_Conds (g), keyword ("loop", pp_C0 (g[N(g)-1], large)));
00440 else if (is_func (g, GEN_TRY))
00441 return keyword ("try", pp_C0 (un_try_catch (g) [1], large));
00442 else if (is_func (g, GEN_DEFINE, 2) && is_func (g[1], GEN_CATCH))
00443 return concat (pp_F0 (g[1]), pp_spc (), pp_C0 (g[2], large));
00444 else if (is_func (g, GEN_RETURN, 1))
00445 return keyword ("return", pp_C0 (g[1], large));
00446 else if (g == GEN_RETURN)
00447 return concat (keyword ("return"), pp_sep (large));
00448 else if (g == GEN_BREAK)
00449 return concat (keyword ("break"), pp_sep (large));
00450 else if (g == GEN_CONTINUE)
00451 return concat (keyword ("continue"), pp_sep (large));
00452 else if (is_func (g, GEN_AUTOFOLD, 1) ||
00453 is_func (g, GEN_INLINE, 1) ||
00454 is_func (g, GEN_INTERN, 1) ||
00455 is_func (g, GEN_METHOD, 1) ||
00456 is_func (g, GEN_EXTERN, 1) ||
00457 is_func (g, GEN_CONSTANT, 1) ||
00458 is_func (g, GEN_MUTABLE, 1) ||
00459 is_func (g, GEN_OUTLINE, 1) ||
00460 is_func (g, GEN_PUBLIC, 1) ||
00461 is_func (g, GEN_PRIVATE, 1))
00462 return keyword (g[0], pp_C0 (g[1], large));
00463 else if (is_func (g, GEN_FOREIGN, 3))
00464 return keyword (g[0], keyword (g[1], keyword (g[2], pp_C0 (g[3], large))));
00465 else if (is_func (g, GEN_FORALL, 2) ||
00466 is_func (g, GEN_EXISTS, 2) ||
00467 is_func (g, GEN_ASSUME, 2) ||
00468 is_func (g, GEN_PENALTY, 2))
00469 return operate (keyword (g[0], bracket ("(", pp_E0 (g[1]), ")")),
00470 pp_C0 (g[2], large));
00471 else if (is_func (g, GEN_CLASS, 1) ||
00472 is_func (g, GEN_MODULE, 1) ||
00473 is_func (g, GEN_CATEGORY, 1))
00474 return concat (keyword (g[0], pp_F0 (g[1])), pp_sep (large));
00475 else if (is_func (g, GEN_CLASS, 2) ||
00476 is_func (g, GEN_MODULE, 2) ||
00477 is_func (g, GEN_CATEGORY, 2))
00478 return keyword (g[0], infix (pp_F0 (g[1]), "==", pp_C0 (g[2], large)));
00479 else if (is_func (g, GEN_DEFINE, 2) ||
00480 is_func (g, GEN_ASSIGN, 2) ||
00481 is_func (g, GEN_DEFINE_MACRO, 2) ||
00482 is_func (g, GEN_ASSIGN_MACRO, 2) ||
00483 is_func (g, GEN_PLUS_ASSIGN, 2) ||
00484 is_func (g, GEN_MINUS_ASSIGN, 2) ||
00485 is_func (g, GEN_TIMES_ASSIGN, 2) ||
00486 is_func (g, GEN_OVER_ASSIGN, 2) ||
00487 is_func (g, GEN_LESSLESSEQ, 2) ||
00488 is_func (g, GEN_GTRGTREQ, 2))
00489 return infix (pp_F0 (g[1]), g[0], pp_C0 (g[2], large));
00490 else if (is_func (g, GEN_PREFER, 2))
00491 return keyword ("prefer", infix (pp_F0 (g[1]), "to",
00492 pp_C0 (g[2], large)));
00493 else if (is_func (g, GEN_LAMBDA) || is_func (g, GEN_MACRO)) {
00494 if (new_lambda_style) {
00495 vector<generic> v= compound_to_vector (g);
00496 generic t= gen (GEN_TUPLE, range (v, 1, N(v) - 1));
00497 generic b= g[N(g)-1];
00498 if (is_func (b, GEN_TYPE, 2)) { t= gen (GEN_TYPE, t, b[2]); b= b[1]; }
00499 return concat (keyword (g[0], pp_E0 (t)),
00500 pp_spc (),
00501 keyword ("do", pp_C0 (b, large)));
00502 }
00503 else {
00504 generic a= pp_E0 (g[1]);
00505 if (N(g) == 4) a= infix (a, ":", pp_E0 (g[3]));
00506 return concat (keyword (g[0], a),
00507 pp_spc (),
00508 keyword ("do", pp_C0 (g[2], large)));
00509 }
00510 }
00511 else return concat (pp_E1 (g), pp_sep (large));
00512 }
00513
00514
00515
00516
00517
00518 generic
00519 mmx_printer::pp_Conds (const generic& conds) {
00520 vector<generic> v;
00521 for (nat i=1; i<N(conds)-1; i++) {
00522 generic g= conds[i];
00523 if (is_func (g, GEN_FOR, 1) ||
00524 is_func (g, GEN_WHILE, 1) ||
00525 is_func (g, GEN_UNTIL, 1) ||
00526 is_func (g, GEN_STEP, 1))
00527 v << keyword (g[0], pp_E0 (g[1])) << pp_spc ();
00528 }
00529 return concat (v);
00530 }
00531
00532
00533
00534
00535
00536 generic
00537 mmx_printer::pp_where (const generic& g) {
00538 return infix (pp_E0 (g[1]), g[0], pp_E0s (g, 2));
00539 }
00540
00541 generic
00542 mmx_printer::pp_E0s (const generic& g, nat start) {
00543 nat n= N (g);
00544 if (start >= n) return concat ();
00545 else if (is_func (g[start], GEN_WHERE) && start==n-1)
00546 return pp_where (g[start]);
00547 else if (is_func (g[start], GEN_VWHERE) && start==n-1)
00548 return pp_where (g[start]);
00549 else {
00550 bool vertical= false;
00551 for (nat i=start; i<n; i++)
00552 vertical= vertical || is_func (g[i], GEN_ROW);
00553 vector<generic> v;
00554 for (nat i=start; i<n; i++)
00555 v << pp_E0 (g[i]);
00556 if (vertical) return vlist (v);
00557 else return hlist (v);
00558 }
00559 }
00560
00561
00562
00563
00564
00565 generic
00566 mmx_printer::pp_E0 (const generic& g) {
00567 if (is_func (g, GEN_FORALL, 2) ||
00568 is_func (g, GEN_EXISTS, 2) ||
00569 is_func (g, GEN_ASSUME, 2) ||
00570 is_func (g, GEN_PENALTY, 2))
00571 return operate (keyword (g[0], bracket ("(", pp_E0 (g[1]), ")")),
00572 pp_E0 (g[2]));
00573 else if (is_func (g, GEN_DEFINE, 2) ||
00574 is_func (g, GEN_ASSIGN, 2) ||
00575 is_func (g, GEN_DEFINE_MACRO, 2) ||
00576 is_func (g, GEN_ASSIGN_MACRO, 2) ||
00577 is_func (g, GEN_PLUS_ASSIGN, 2) ||
00578 is_func (g, GEN_MINUS_ASSIGN, 2) ||
00579 is_func (g, GEN_TIMES_ASSIGN, 2) ||
00580 is_func (g, GEN_OVER_ASSIGN, 2) ||
00581 is_func (g, GEN_LESSLESSEQ, 2) ||
00582 is_func (g, GEN_GTRGTREQ, 2))
00583 return infix (pp_F0 (g[1]), g[0], pp_E0 (g[2]));
00584 else return pp_E1 (g);
00585 }
00586
00587 generic
00588 mmx_printer::pp_E1 (const generic& g) {
00589 if (is_func (g, GEN_LAMBDA) || is_func (g, GEN_MACRO)) {
00590 if (new_lambda_style) {
00591 vector<generic> v= compound_to_vector (g);
00592 generic t= gen (GEN_TUPLE, range (v, 1, N(v) - 1));
00593 generic b= g[N(g)-1];
00594 if (is_func (b, GEN_TYPE, 2)) { t= gen (GEN_TYPE, t, b[2]); b= b[1]; }
00595 generic d= (is_C0 (b)? pp_C0 (b): pp_E0 (b));
00596 return concat (keyword (g[0], pp_E0 (t)), pp_spc (), keyword ("do", d));
00597 }
00598 else {
00599 generic a= pp_E0 (g[1]);
00600 if (N(g) == 4) a= infix (a, ":", pp_E0 (g[3]));
00601 generic b= (is_C0 (g[2])? pp_C0 (g[2]): pp_E0 (g[2]));
00602 return concat (keyword (g[0], a), pp_spc (), keyword ("do", b));
00603 }
00604 }
00605 else if (is_func (g, GEN_MAPSTO, 2))
00606 return infix (pp_E2 (g[1]), g[0], pp_E2 (g[2]));
00607 else return pp_E2 (g);
00608 }
00609
00610 generic
00611 mmx_printer::pp_E2 (const generic& g) {
00612 if (is_func (g, GEN_LESSLESS, 2))
00613 return infix (pp_Lflux (g[1]), g[0], pp_F0 (g[2]));
00614 else if (is_func (g, GEN_GTRGTR, 2))
00615 return infix (pp_F0 (g[1]), g[0], pp_Rflux (g[2]));
00616 else return pp_F0 (g);
00617 }
00618
00619 generic
00620 mmx_printer::pp_Lflux (const generic& g) {
00621 if (is_func (g, GEN_LESSLESS, 2))
00622 return infix (pp_Lflux (g[1]), g[0], pp_F0 (g[2]));
00623 else return pp_F0 (g);
00624 }
00625
00626 generic
00627 mmx_printer::pp_Rflux (const generic& g) {
00628 if (is_func (g, GEN_GTRGTR, 2))
00629 return infix (pp_F0 (g[1]), g[0], pp_Rflux (g[2]));
00630 else return pp_F0 (g);
00631 }
00632
00633
00634
00635
00636
00637 generic
00638 mmx_printer::pp_F0 (const generic& g) {
00639 if (is_func (g, GEN_IMPLIES, 2) ||
00640 is_func (g, GEN_EQUIV, 2))
00641 return infix (pp_F1 (g[1]), g[0], pp_F1 (g[2]));
00642 else return pp_F1 (g);
00643 }
00644
00645 generic
00646 mmx_printer::pp_F1 (const generic& g) {
00647 if (is_func (g, GEN_SEQOR, 2))
00648 return infix (pp_Seqors (g[1]), g[0], pp_Seqors (g[2]));
00649 else if (is_func (g, GEN_OR, 2))
00650 return infix (pp_Ors (g[1]), g[0], pp_Ors (g[2]));
00651 else if (is_func (g, GEN_XOR, 2))
00652 return infix (pp_Xors (g[1]), g[0], pp_Xors (g[2]));
00653 else return pp_F2 (g);
00654 }
00655
00656 generic
00657 mmx_printer::pp_Seqors (const generic& g) {
00658 if (is_func (g, GEN_SEQOR, 2))
00659 return infix (pp_Seqors (g[1]), g[0], pp_Seqors (g[2]));
00660 else return pp_F2 (g);
00661 }
00662
00663 generic
00664 mmx_printer::pp_Ors (const generic& g) {
00665 if (is_func (g, GEN_OR, 2))
00666 return infix (pp_Ors (g[1]), g[0], pp_Ors (g[2]));
00667 else return pp_F2 (g);
00668 }
00669
00670 generic
00671 mmx_printer::pp_Xors (const generic& g) {
00672 if (is_func (g, GEN_XOR, 2))
00673 return infix (pp_Xors (g[1]), g[0], pp_Xors (g[2]));
00674 else return pp_F2 (g);
00675 }
00676
00677 generic
00678 mmx_printer::pp_F2 (const generic& g) {
00679 if (is_func (g, GEN_AND, 2))
00680 return infix (pp_Ands (g[1]), g[0], pp_Ands (g[2]));
00681 else if (is_func (g, GEN_SEQAND, 2))
00682 return infix (pp_Seqands (g[1]), g[0], pp_Seqands (g[2]));
00683 else return pp_F3 (g);
00684 }
00685
00686 generic
00687 mmx_printer::pp_Seqands (const generic& g) {
00688 if (is_func (g, GEN_SEQAND, 2))
00689 return infix (pp_Seqands (g[1]), g[0], pp_Seqands (g[2]));
00690 else return pp_F3 (g);
00691 }
00692
00693 generic
00694 mmx_printer::pp_Ands (const generic& g) {
00695 if (is_func (g, GEN_AND, 2) || is_func (g, GEN_SEQAND, 2))
00696 return infix (pp_Ands (g[1]), g[0], pp_Ands (g[2]));
00697 else return pp_F3 (g);
00698 }
00699
00700 generic
00701 mmx_printer::pp_F3 (const generic& g) {
00702 if (is_func (g, GEN_EQUAL, 2) ||
00703 is_func (g, GEN_UNEQUAL, 2) ||
00704 is_func (g, GEN_LESS, 2) ||
00705 is_func (g, GEN_LESSEQ, 2) ||
00706 is_func (g, GEN_GTR, 2) ||
00707 is_func (g, GEN_GTREQ, 2))
00708 return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
00709 else if (is_func (g, GEN_TYPE, 2))
00710 return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
00711 else if (is_func (g, GEN_IN, 2) && is_func (g[1], GEN_TYPE, 2))
00712 return infix (pp_F3 (g[1]), g[0], pp_T0 (g[2]));
00713 else if (is_func (g, GEN_IN, 2))
00714 return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
00715 else return pp_T0 (g);
00716 }
00717
00718
00719
00720
00721
00722 generic
00723 mmx_printer::pp_T0 (const generic& g) {
00724 if (is_func (g, GEN_VARTYPE, 2) ||
00725 is_func (g, GEN_TRANSTYPE, 2) ||
00726 is_func (g, GEN_VARTRANSTYPE, 2))
00727 return infix (pp_T0 (g[1]), g[0], pp_T1 (g[2]));
00728 else if ((is_func (g, GEN_COERCE, 2) ||
00729 (is_func (g, GEN_COERCE_TYPE) && N(g) > 2)) &&
00730 mmx_abbreviate_coerce) {
00731
00732 if (is_func (g, GEN_COERCE_TYPE) && g[2] == "Class")
00733 return postfix (pp_T0 (g[1]), " [C]");
00734
00735
00736
00737
00738 generic op= GEN_TRANSTYPE;
00739 if (is_func (g, GEN_COERCE_TYPE)) op= "::>";
00740 if (is_func (g, GEN_COERCE_TYPE) && N(g) >= 4) {
00741 if (is_func (g[3], "ABBREVIATE", 1) && is<literal> (g[3][1])) {
00742 string s= ":" * literal_to_string (g[3][1]) * ">";
00743 op= s;
00744 }
00745 else if (g[3] == generic ("HYPOTHESIS")) op= ":!>";
00746 else if (g[3] == generic ("ALTER")) op= "::>";
00747 else if (N(g) >= 5 && is_func (g[4], "#")) {
00748 ASSERT (is<literal> (g[4][2]), "literal expected");
00749 op= ":+" * literal_to_string (g[4][2]) * "+>";
00750 }
00751
00752 else op= ":+>";
00753 }
00754 return infix (pp_T0 (g[1]), op, pp_T1 (g[2]));
00755 }
00756 else return pp_T1 (g);
00757 }
00758
00759 generic
00760 mmx_printer::pp_T1 (const generic& g) {
00761 if (is_func (g, GEN_INTO, 2) ||
00762 is_func (g, GEN_MAPSTO, 2) ||
00763 is_func (g, GEN_CONVERTS, 2))
00764 return infix (pp_T2 (g[1]), g[0], pp_T2 (g[2]));
00765 else return pp_T2 (g);
00766 }
00767
00768 generic
00769 mmx_printer::pp_T2 (const generic& g) {
00770 if (is_func (g, GEN_RANGE, 2))
00771 return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
00772 else if (is_func (g, GEN_TO, 2))
00773 return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
00774 else if (is_func (g, GEN_DOWNTO, 2))
00775 return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
00776 else return pp_T3 (g);
00777 }
00778
00779 static void
00780 collect (vector<generic>& v, const generic& g, nat depth) {
00781 if (depth >= 16384) v << g;
00782 else if (is_func (g, GEN_PLUS, 2)) {
00783 collect (v, g[1], depth+1);
00784 collect (v, g[2], depth+1);
00785 }
00786 else if (is_func (g, GEN_MINUS, 2)) {
00787 collect (v, g[1], depth+1);
00788 v << gen (GEN_MINUS, g[2]);
00789 }
00790 else v << g;
00791 }
00792
00793 static vector<generic>
00794 collect (const generic& g) {
00795 vector<generic> v;
00796 collect (v, g, 0);
00797 vector<generic> w;
00798 for (nat i=0; i<N(v); i++)
00799 if (is_func (v[i], GEN_PLUS, 2) || is_func (v[i], GEN_MINUS, 2))
00800 w << collect (v[i]);
00801 else w << v[i];
00802 return w;
00803 }
00804
00805 generic
00806 mmx_printer::pp_T3 (const generic& g) {
00807 if (is_func (g, GEN_PLUS, 2) || is_func (g, GEN_MINUS, 2)) {
00808 vector<generic> v= collect (g);
00809 for (nat i=0; i<N(v); i++)
00810 if (is_func (v[i], GEN_MINUS, 1))
00811 v[i]= gen (GEN_MINUS, pp_T4 (v[i][1]));
00812 else v[i]= pp_T3 (v[i]);
00813 return bigop (GEN_PLUS, v);
00814 }
00815 else return pp_T4 (g);
00816 }
00817
00818 generic
00819 mmx_printer::pp_T4 (const generic& g) {
00820 if (is_func (g, GEN_TIMES, 2) ||
00821 is_func (g, GEN_COMPOSE, 2) ||
00822 is_func (g, GEN_APPEND, 2))
00823 return infix (pp_T4 (g[1]), g[0], pp_T4 (g[2]));
00824 else if (is_func (g, GEN_OVER, 2) ||
00825 is_func (g, GEN_SIZE, 2) ||
00826 is_func (g, "%", 2) ||
00827 is_func (g, "&", 2))
00828 return infix (pp_T4 (g[1]), g[0], pp_T5 (g[2]));
00829 else if (is_func (g, GEN_DIV, 2))
00830 return infix (pp_T4 (g[1]), "div", pp_T5 (g[2]));
00831 else if (is_func (g, GEN_QUO, 2))
00832 return infix (pp_T4 (g[1]), "quo", pp_T5 (g[2]));
00833 else if (is_func (g, GEN_REM, 2))
00834 return infix (pp_T4 (g[1]), "rem", pp_T5 (g[2]));
00835 else if (is_func (g, GEN_MOD, 2))
00836 return infix (pp_T4 (g[1]), "mod", pp_T5 (g[2]));
00837 else return pp_T5 (g);
00838 }
00839
00840 generic
00841 mmx_printer::pp_T5 (const generic& g) {
00842 if (is_func (g, GEN_MINUS, 1))
00843 return prefix (g[0], pp_R0 (g[1]));
00844 else if (is_func (g, GEN_EXPLODE, 1) ||
00845 is_func (g, GEN_SIZE, 1) ||
00846 is_func (g, "%", 1) ||
00847 is_func (g, "&", 1) ||
00848 is_func (g, GEN_NOT, 1))
00849 return prefix (g[0], pp_T5 (g[1]));
00850 else if (is<literal> (g) && g != GEN_MINUS &&
00851 starts (literal_to_string (g), "-"))
00852 return pp_verb (literal_to_string (g));
00853 else return pp_R0 (g);
00854 }
00855
00856
00857
00858
00859
00860 generic
00861 mmx_printer::pp_R0 (const generic& g) {
00862 return pp_R1 (g);
00863 }
00864
00865 generic
00866 mmx_printer::pp_R1 (const generic& g) {
00867 if (is_func (g, GEN_POWER, 2) || is_func (g, GEN_FILL, 2))
00868 return infix (pp_R2 (g[1]), g[0], pp_R2 (g[2]));
00869 else return pp_R2 (g);
00870 }
00871
00872 generic
00873 mmx_printer::pp_R2 (const generic& g) {
00874 if (is_func (g, GEN_FACTORIAL, 1))
00875 return postfix (pp_R2 (g[1]), "!");
00876 else if (is_func (g, GEN_PRIME, 1))
00877 return postfix (pp_R2 (g[1]), "'");
00878 else if (is_func (g, GEN_BACKPRIME, 1))
00879 return postfix (pp_R2 (g[1]), "`");
00880 else if (is_func (g, GEN_STAR, 1))
00881 return postfix (pp_R2 (g[1]), "*");
00882 else if (is_func (g, GEN_HAT, 1))
00883 return postfix (pp_R2 (g[1]), "^");
00884 else if (is_func (g, GEN_TILDA, 1))
00885 return postfix (pp_R2 (g[1]), "~");
00886 else if (is_func (g, GEN_QUOTE, 1) || is_func (g, GEN_BACKQUOTE, 1)) {
00887 if (is<literal> (g[1]))
00888 return prefix (g[0], pp_verb (literal_to_string (g[1])));
00889 else if (is_func (g[1], GEN_QUOTE, 1) || is_func (g[1], GEN_BACKQUOTE, 1))
00890 return prefix (g[0], pp_E0 (g[1]));
00891 else return prefix (g[0], bracket ("(", pp_E0 (g[1]), ")"));
00892 }
00893 else if (N(g) == 2 &&
00894 is<literal> (g[0]) &&
00895 starts (literal_to_string (g[0]), "."))
00896 return concat (pp_R2 (g[1]), pp_verb (literal_to_string (g[0])));
00897 else if (is_func (g, GEN_ACCESS))
00898 return operate (pp_R2 (g[1]), bracket ("[", pp_E0s (g, 2), "]"));
00899 else if (is_func (g, GEN_LITERAL_FLOATING, 1) && is<literal> (g[1]))
00900 return pp_verb (literal_to_string (g[1]));
00901 else if (is_func (g, GEN_LITERAL_INTEGER, 1) && is<literal> (g[1]))
00902 return pp_verb (literal_to_string (g[1]));
00903 else if (is_func (g, GEN_LITERAL_STRING, 1) && is<literal> (g[1]))
00904 return pp_verb (literal_to_string (g[1]));
00905 else if ((is<compound> (g) && is_applicable (g[0])) ||
00906 (!is_nil (gl) && exact_eq (read_car (gl), g))) {
00907 if (is<literal> (g)) return pp_verb (literal_to_string (g));
00908 else if (is<literal> (g[0])) {
00909 string op= literal_to_string (g[0]);
00910 if (starts (op, "$") || starts (op, "tm$")) {
00911 vector<generic> v= vec<generic> (g[0]);
00912 for (nat i=1; i<N(g); i++) v << pp_E0 (g[i]);
00913 return vector_to_compound (v);
00914 }
00915 }
00916 if (is_func (g, GEN_PARTIAL, 1) && is<literal> (g[1]))
00917 return operate (pp_R2 (g[0]), pp_E0s (g, 1));
00918 if (N(g) == 2 && is_func (g[0], GEN_POWER, 2) &&
00919 exact_eq (g[0][1], GEN_PARTIAL) && is<literal> (g[1]))
00920 return operate (pp_R1 (g[0]), pp_E0s (g, 1));
00921 return operate (pp_R2 (g[0]), bracket ("(", pp_E0s (g, 1), ")"));
00922 }
00923 else return pp_R3 (g);
00924 }
00925
00926 generic
00927 mmx_printer::pp_R3 (const generic& g) {
00928 if (is<literal> (g) && !starts (literal_to_string (g), "-"))
00929 return pp_verb (literal_to_string (g));
00930 else if (is_func (g, GEN_SQTUPLE))
00931 return bracket ("[", pp_E0s (g, 1), "]");
00932 else if (is_func (g, GEN_TUPLE))
00933 return bracket ("(", pp_E0s (g, 1), ")");
00934 else if (is_func (g, GEN_ROW))
00935 return pp_E0s (g, 1);
00936 else if (is_func (g, GEN_WHERE) || is_func (g, GEN_VWHERE))
00937 return bracket ("(", pp_where (g), ")");
00938 else {
00939 gl= cons (g, gl);
00940 generic r= pp_E0 (g);
00941 gl= read_cdr (gl);
00942 return bracket ("(", r, ")");
00943 }
00944 }
00945
00946
00947
00948
00949
00950 generic
00951 print_mmx (const generic& g) {
00952 vector<generic> v;
00953 mmx_printer pp;
00954 if (is_func (g, GEN_BEGIN))
00955 for (nat i=1; i<N(g); i++)
00956 v << pp.pp_C0 (g[i], i<N(g)-1);
00957 else if (is_C0 (g)) v << pp.pp_C0 (g);
00958 else v << pp.pp_E0 (g);
00959 return concat (v);
00960 }
00961
00962 string
00963 as_mmx (const generic& g) {
00964 return serialize (print_mmx (g));
00965 }
00966
00967 string
00968 flatten_as_mmx (const generic& g) {
00969 generic f= as_generic (flatten (g));
00970 return as_mmx (f);
00971 }
00972
00973 string
00974 output_as_mmx (const generic& g) {
00975 if (math_mode) {
00976 string r;
00977 r << DATA_BEGIN << "scheme:";
00978 r << flatten_as_texmacs_scheme (g);
00979 r << DATA_END;
00980 return r;
00981 }
00982 else {
00983 generic f= as_generic (flatten (g));
00984 return as_mmx (f);
00985 }
00986 }
00987
00988 string
00989 string_as_mmx (const string& s) {
00990
00991 return s;
00992 }
00993
00994 }
