/Users/mourrain/Devel/mmx/basix/src/mmx_printer.cpp

Go to the documentation of this file.

/******************************************************************************
* MODULE     : mmx_printer.cpp
* DESCRIPTION: Printing as mathemagix expressions
* COPYRIGHT  : (C) 2000  Joris van der Hoeven
*******************************************************************************
* This software falls under the GNU general public license and comes WITHOUT
* ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for more details.
* If you don't have this file, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************/

#include <basix/list.hpp>
#include <basix/literal.hpp>
#include <basix/compound.hpp>
#include <basix/mmx_syntax.hpp>
#include <basix/math_syntax.hpp>
namespace mmx {

#define DATA_BEGIN   ((char) 2)
#define DATA_END     ((char) 5)

bool mmx_abbreviate_coerce= true;

/******************************************************************************
* The mmx_printer class
******************************************************************************/

class mmx_printer {
MMX_ALLOCATORS
private:
  list<generic> gl;

private:
  generic pp_verb (const string& s);
  generic pp_spc ();
  generic pp_lf ();
  generic pp_sep (bool large);

  generic pp_C0 (const generic& g, bool large= false);
  generic pp_Conds (const generic& conds);

  generic pp_where (const generic& g);
  generic pp_E0s (const generic& g, nat start);

  generic pp_E1 (const generic& g);
  generic pp_E2 (const generic& g);
  generic pp_Lflux (const generic& g);
  generic pp_Rflux (const generic& g);

  generic pp_F0 (const generic& g);
  generic pp_Seqors (const generic& g);
  generic pp_Ors (const generic& g);
  generic pp_Xors (const generic& g);
  generic pp_F1 (const generic& g);
  generic pp_Seqands (const generic& g);
  generic pp_Ands (const generic& g);
  generic pp_F2 (const generic& g);
  generic pp_F3 (const generic& g);

  generic pp_T0 (const generic& g);
  generic pp_T1 (const generic& g);
  generic pp_T2 (const generic& g);
  generic pp_T3 (const generic& g);
  generic pp_T4 (const generic& g);
  generic pp_T5 (const generic& g);

  generic pp_R0 (const generic& g);
  generic pp_R1 (const generic& g);
  generic pp_R2 (const generic& g);
  generic pp_R3 (const generic& g);

public:
  inline mmx_printer () {}
  inline ~mmx_printer () {}

  generic pp_E0 (const generic& g);
  friend generic print_mmx (const generic& g);
};

/******************************************************************************
* Printing to strings
******************************************************************************/

enum print_controls { LF, INDENT, VARINDENT, UNINDENT };

static nat indentation_level= 0;

static string&
operator << (string& out, print_controls pc) {
  switch (pc) {
  case LF:
    out << "\n";
    for (nat i=0; i<indentation_level; i++) out << "  ";
    break;
  case INDENT:
    indentation_level++;
    out << "  ";
    break;
  case VARINDENT:
    indentation_level++;
    break;
  case UNINDENT:
    indentation_level--;
    if (N(out) >= 2 && out[N(out)-2] == ' ' && out[N(out)-1] == ' ')
      inside (out) -> resize (N(out) - 2);
    break;
  }
  return out;
}

/******************************************************************************
* Concatenation
******************************************************************************/

inline generic concat (const vector<generic>& v) {
  return gen ("$concat", v); }
inline generic concat () {
  return gen ("$concat"); }
inline generic concat (const generic& g1, const generic& g2) {
  return gen ("$concat", g1, g2); }
inline generic concat (const generic& g1, const generic& g2,
                       const generic& g3) {
  return gen ("$concat", g1, g2, g3); }
inline generic concat (const generic& g1, const generic& g2,
                       const generic& g3, const generic& g4) {
  return gen ("$concat", g1, g2, g3, g4); }
  
inline generic infix (const generic& g, const generic& op, const generic& h) {
  return gen ("$infix", g, op, h); }
inline generic bigop (const generic& op, const vector<generic>& v) {
  return gen ("$bigop", cons (op, v)); }
inline generic bracket (const generic& l, const generic& g, const generic& r) {
  return gen ("$bracket", l, g, r); }
inline generic postfix (const generic& g, const generic& op) {
  return gen ("$postfix", g, op); }
inline generic prefix (const generic& op, const generic& g) {
  return gen ("$prefix", op, g); }
inline generic operate (const generic& g, const generic& h) {
  return gen ("$operate", g, h); }
inline generic keyword (const generic& g) {
  return gen ("$keyword", g); }
inline generic keyword (const generic& op, const generic& g) {
  return gen ("$keyword", op, g); }
inline generic hlist (const vector<generic>& v) {
  return gen ("$hlist", v); }
inline generic vlist (const vector<generic>& v) {
  return gen ("$vlist", v); }
inline generic indented (const vector<generic>& v) {
  return gen ("$indent", v); }

static inline void
init (table<generic,generic>& t, const generic& key, const generic& val) {
  t[key]= val;
}

static table<generic,generic>
mmx_symbol_table () {
  table<generic,generic> t;
  init (t, "mathcatalan", "K");
  init (t, "partial", "d");
  init (t, "derivative", "D");
  init (t, "matheuler", "gamma");
  init (t, "mathd", "d");
  init (t, "mathe", "e");
  init (t, "mathi", "i");
  init (t, "mathpi", "pi");
  return t;
}

static void
serialize (string& s, const generic& g) {
  if (is<literal> (g)) {
    static table<generic,generic> t= mmx_symbol_table ();
    if (contains (t, g)) s << literal_to_string (t[g]);
    else if (g == "$spc") s << " ";
    else if (g == "$lf") s << LF;
    else if (g == "$cr");
    else s << literal_to_string (g);
  }
  else if (is_func (g, "$concat") ||
           is_func (g, "$bracket") ||
           is_func (g, "$prefix") ||
           is_func (g, "$postfix"))
    for (nat i=1; i<N(g); i++)
      serialize (s, g[i]);
  else if (is_func (g, "$infix", 3)) {
    serialize (s, g[1]);
    if (g[2] != "^" && g[2] != "^^") s << " ";
    serialize (s, g[2]);
    if (g[2] != "^" && g[2] != "^^") s << " ";
    serialize (s, g[3]); 
  }
  else if (is_func (g, "$bigop") && N(g) >= 3) {
    if (g[1] == GEN_PLUS && is_func (g[2], GEN_MINUS, 1)) {
      s << "-";
      serialize (s, g[2][1]);
    }
    else serialize (s, g[2]);
    for (nat i=3; i<N(g); i++) {
      if (g[1] == GEN_PLUS && is_func (g[i], GEN_MINUS, 1)) {
        s << " " << "-" << " ";
        serialize (s, g[i][1]);
      }
      else {
        s << " ";
        serialize (s, g[1]);
        s << " ";
        serialize (s, g[i]);
      }
    }
  }
  else if (is_func (g, "$keyword", 1))
    serialize (s, g[1]);
  else if (is_func (g, "$operate", 2) ||
           is_func (g, "$keyword", 2)) {
    serialize (s, g[1]);
    s << " ";
    serialize (s, g[2]);
  }
  else if (is_func (g, "$hlist") ||
           is_func (g, "$vlist")) {
    if (N(g) == 1) return;
    serialize (s, g[1]);
    for (nat i=2; i<N(g); i++) {
      if (g[0] == "$hlist") s << ", ";
      else s << "; ";
      serialize (s, g[i]);
    }
  }
  else if (is_func (g, "$indent")) {
    s << INDENT;
    for (nat i=1; i<N(g); i++)
      serialize (s, g[i]);
    s << UNINDENT;
  }
  else if (is_func (g, "$varindent")) {
    serialize (s, g[1]);
    s << VARINDENT;
    for (nat i=2; i<N(g); i++)
      serialize (s, g[i]);
    s << UNINDENT;
  }
  else if (is_func (g, "$text", 1))
    serialize (s, g[1]);
  else if (is_func (g, "$math", 1))
    serialize (s, g[1]);
  else if (is_func (g, "$dynamic", 2)) {
    s << "< ";
    serialize (s, g[1]);
    s << " | ";
    serialize (s, g[2]);
    s << " >";
  }
  else if (is<compound> (g) && is<literal> (g[0]) &&
           starts (as_string (as<literal> (g[0])), "tm$")) {
    generic h= texmacs_expand (g);
    serialize (s, h);
  }
  else {
    serialize (s, g[0]);
    s << " (";
    for (nat i=1; i<N(g); i++) {
      if (i != 1) s << ", ";
      serialize (s, g[i]);
    }
    s << ")";
  }
}

static string
serialize (const generic& g) {
  string s;
  serialize (s, g);
  return s;
}

/******************************************************************************
* Helper routines
******************************************************************************/

generic
mmx_printer::pp_verb (const string& s) {
  return generic (s);
}

generic
mmx_printer::pp_spc () {
  return generic ("$spc");
}

generic
mmx_printer::pp_lf () {
  return generic ("$lf");
}

generic
mmx_printer::pp_sep (bool large) {
  if (large) return concat (pp_verb (";"), pp_lf ());
  else return concat ();
}

/******************************************************************************
* Predicates
******************************************************************************/

static bool
is_C0 (const generic& g) {
  if (is_func (g, GEN_BEGIN) ||
      is_func (g, GEN_IF) ||
      is_func (g, GEN_LOOP) ||
      is_func (g, GEN_BREAK) ||
      is_func (g, GEN_CONTINUE) ||
      is_func (g, GEN_TRY) ||
      is_func (g, GEN_LAMBDA) ||
      is_func (g, GEN_MACRO) ||
      is_func (g, GEN_RETURN) ||
      is_func (g, GEN_CLASS) ||
      is_func (g, GEN_MODULE) ||
      is_func (g, GEN_CATEGORY))
    return true;
  if (N(g) == 2 && is_C0 (g[1]))
    return
      is_func (g, GEN_INTERN) ||
      is_func (g, GEN_METHOD) ||
      is_func (g, GEN_EXTERN) ||
      is_func (g, GEN_MUTABLE) ||
      is_func (g, GEN_CONSTANT) ||
      is_func (g, GEN_PUBLIC) ||
      is_func (g, GEN_PRIVATE);
  if (N(g) == 3 && is_C0 (g[2]))
    return
      is_func (g, GEN_FORALL) ||
      is_func (g, GEN_EXISTS) ||
      is_func (g, GEN_ASSUME) ||
      is_func (g, GEN_PENALTY) ||
      is_func (g, GEN_DEFINE) ||
      is_func (g, GEN_ASSIGN) ||
      is_func (g, GEN_DEFINE_MACRO) ||
      is_func (g, GEN_ASSIGN_MACRO) ||
      is_func (g, GEN_PLUS_ASSIGN) ||
      is_func (g, GEN_MINUS_ASSIGN) ||
      is_func (g, GEN_TIMES_ASSIGN) ||
      is_func (g, GEN_OVER_ASSIGN) ||
      is_func (g, GEN_LESSLESSEQ) ||
      is_func (g, GEN_GTRGTREQ);
  if (N(g) == 4 && is_C0 (g[3]))
    return
      is_func (g, GEN_FOREIGN);
  return false;
}

static bool
is_applicable (const generic& g) {
  if (is<literal> (g)) {
    const string s= literal_to_string (g);
    if (N(s)==0) return false;
    for (nat i=0; i<N(s); i++)
      if (s[i] == '.') {
        if (i != 0 || N(s) == 1) return false; }
      else if (((s[i]<'0') || (s[i]>'9')) &&
               ((s[i]<'a') || (s[i]>'z')) &&
               ((s[i]<'A') || (s[i]>'Z')) &&
               ((s[i]!='_') && (s[i]!='?') && (s[i]!='$')))
        return false;
      else if (s[i] == '$') return true;
  }
  return
    g != GEN_SEQAND && g != GEN_SEQOR && g != GEN_XOR &&
    g != GEN_LAMBDA && g != GEN_MACRO &&
    g != GEN_COERCE && g != GEN_COERCE_TYPE;
}

/******************************************************************************
* Commands
******************************************************************************/

static generic
un_try_catch (const generic& g) {
  vector<generic> v;
  if (is_func (g[1], GEN_BEGIN)) v << cdr (compound_to_vector (g[1]));
  else v << g[1];
  for (nat i=2; i<N(g); i++) v << g[i];
  return gen (g[0], gen (GEN_BEGIN, v));
}

generic
mmx_printer::pp_C0 (const generic& g, bool large) {
  if (is_func (g, GEN_BEGIN)) {
    if (N(g) == 1) return concat (pp_verb ("{"), pp_verb ("}"));
    vector<generic> v, w;
    v << pp_verb ("{") << pp_lf ();
    for (nat i=1; i<N(g); i++)
      w << pp_C0 (g[i], true);
    v << indented (w);
    v << pp_verb ("}");
    if (large) v << pp_lf ();
    return concat (v);
  }
  else if (is_func (g, GEN_IF, 2)) {
    generic t= g[2];
    if (is_func (g[2], GEN_IF)) t= gen (GEN_BEGIN, g[2]);
    return concat (keyword ("if", pp_E0 (g[1])),
                   pp_spc (),
                   keyword ("then", pp_C0 (t, large)));
  }
  else if (is_func (g, GEN_IF, 3)) {
    generic t= g[2];
    if (is_func (g[2], GEN_IF)) t= gen (GEN_BEGIN, g[2]);
    bool large2= is_C0 (t);
    return concat (vec (keyword ("if", pp_E0 (g[1])),
                        pp_spc (),
                        keyword ("then", pp_C0 (t, large2)),
                        large2? concat (): pp_spc (),
                        keyword ("else", pp_C0 (g[3], large))));
  }
  else if (is_func (g, GEN_LOOP))
    return concat (pp_Conds (g), keyword ("loop", pp_C0 (g[N(g)-1], large)));
  else if (is_func (g, GEN_TRY))
    return keyword ("try", pp_C0 (un_try_catch (g) [1], large));
  else if (is_func (g, GEN_DEFINE, 2) && is_func (g[1], GEN_CATCH))
    return concat (pp_F0 (g[1]), pp_spc (), pp_C0 (g[2], large));
  else if (is_func (g, GEN_RETURN, 1))
    return keyword ("return", pp_C0 (g[1], large));
  else if (g == GEN_RETURN)
    return concat (keyword ("return"), pp_sep (large));
  else if (g == GEN_BREAK)
    return concat (keyword ("break"), pp_sep (large));
  else if (g == GEN_CONTINUE)
    return concat (keyword ("continue"), pp_sep (large));
  else if (is_func (g, GEN_INTERN, 1) ||
           is_func (g, GEN_METHOD, 1) ||
           is_func (g, GEN_EXTERN, 1) ||
           is_func (g, GEN_CONSTANT, 1) ||
           is_func (g, GEN_MUTABLE, 1) ||
           is_func (g, GEN_PUBLIC, 1) ||
           is_func (g, GEN_PRIVATE, 1))
    return keyword (g[0], pp_C0 (g[1], large));
  else if (is_func (g, GEN_FOREIGN, 3))
    return keyword (g[0], keyword (g[1], keyword (g[2], pp_C0 (g[3], large))));
  else if (is_func (g, GEN_FORALL, 2) ||
           is_func (g, GEN_EXISTS, 2) ||
           is_func (g, GEN_ASSUME, 2) ||
           is_func (g, GEN_PENALTY, 2))
    return operate (keyword (g[0], bracket ("(", pp_E0 (g[1]), ")")),
                    pp_C0 (g[2], large));
  else if (is_func (g, GEN_CLASS, 1) ||
           is_func (g, GEN_MODULE, 1) ||
           is_func (g, GEN_CATEGORY, 1))
    return concat (keyword (g[0], pp_F0 (g[1])), pp_sep (large));
  else if (is_func (g, GEN_CLASS, 2) ||
           is_func (g, GEN_MODULE, 2) ||
           is_func (g, GEN_CATEGORY, 2))
    return keyword (g[0], infix (pp_F0 (g[1]), "==", pp_C0 (g[2], large)));
  else if (is_func (g, GEN_DEFINE, 2) ||
           is_func (g, GEN_ASSIGN, 2) ||
           is_func (g, GEN_DEFINE_MACRO, 2) ||
           is_func (g, GEN_ASSIGN_MACRO, 2) ||
           is_func (g, GEN_PLUS_ASSIGN, 2) ||
           is_func (g, GEN_MINUS_ASSIGN, 2) ||
           is_func (g, GEN_TIMES_ASSIGN, 2) ||
           is_func (g, GEN_OVER_ASSIGN, 2) ||
           is_func (g, GEN_LESSLESSEQ, 2) ||
           is_func (g, GEN_GTRGTREQ, 2))
    return infix (pp_F0 (g[1]), g[0], pp_C0 (g[2], large));
  else if (is_func (g, GEN_LAMBDA) || is_func (g, GEN_MACRO)) {
    if (new_lambda_style) {
      vector<generic> v= compound_to_vector (g);
      generic t= gen (GEN_TUPLE, range (v, 1, N(v) - 1));
      generic b= g[N(g)-1];
      if (is_func (b, GEN_TYPE, 2)) { t= gen (GEN_TYPE, t, b[2]); b= b[1]; }
      return concat (keyword (g[0], pp_E0 (t)),
                     pp_spc (),
                     keyword ("do", pp_C0 (b, large)));
    }
    else {
      generic a= pp_E0 (g[1]);
      if (N(g) == 4) a= infix (a, ":", pp_E0 (g[3]));
      return concat (keyword (g[0], a),
                     pp_spc (),
                     keyword ("do", pp_C0 (g[2], large)));
    }
  }
  else return concat (pp_E1 (g), pp_sep (large));
}

/******************************************************************************
* Special programming constructs
******************************************************************************/

generic
mmx_printer::pp_Conds (const generic& conds) {
  vector<generic> v;
  for (nat i=1; i<N(conds)-1; i++) {
    generic g= conds[i];
    if (is_func (g, GEN_FOR, 1) ||
        is_func (g, GEN_WHILE, 1) ||
        is_func (g, GEN_UNTIL, 1) ||
        is_func (g, GEN_STEP, 1))
      v << keyword (g[0], pp_E0 (g[1])) << pp_spc ();
  }
  return concat (v);
}

/******************************************************************************
* Tuples
******************************************************************************/

generic
mmx_printer::pp_where (const generic& g) {
  return infix (pp_E0 (g[1]), g[0], pp_E0s (g, 2));
}

generic
mmx_printer::pp_E0s (const generic& g, nat start) {
  nat n= N (g);
  if (start >= n) return concat ();
  else if (is_func (g[start], GEN_WHERE) && start==n-1)
    return pp_where (g[start]);
  else if (is_func (g[start], GEN_VWHERE) && start==n-1)
    return pp_where (g[start]);
  else {
    bool vertical= false;
    for (nat i=start; i<n; i++)
      vertical= vertical || is_func (g[i], GEN_ROW);
    vector<generic> v;
    for (nat i=start; i<n; i++)
      v << pp_E0 (g[i]);
    if (vertical) return vlist (v);
    else return hlist (v);
  }
}

/******************************************************************************
* Expressions
******************************************************************************/

generic
mmx_printer::pp_E0 (const generic& g) {
  if (is_func (g, GEN_FORALL, 2) ||
      is_func (g, GEN_EXISTS, 2) ||
      is_func (g, GEN_ASSUME, 2) ||
      is_func (g, GEN_PENALTY, 2))
    return operate (keyword (g[0], bracket ("(", pp_E0 (g[1]), ")")),
                    pp_E0 (g[2]));
  else if (is_func (g, GEN_DEFINE, 2) ||
           is_func (g, GEN_ASSIGN, 2) ||
           is_func (g, GEN_DEFINE_MACRO, 2) ||
           is_func (g, GEN_ASSIGN_MACRO, 2) ||
           is_func (g, GEN_PLUS_ASSIGN, 2) ||
           is_func (g, GEN_MINUS_ASSIGN, 2) ||
           is_func (g, GEN_TIMES_ASSIGN, 2) ||
           is_func (g, GEN_OVER_ASSIGN, 2) ||
           is_func (g, GEN_LESSLESSEQ, 2) ||
           is_func (g, GEN_GTRGTREQ, 2))
    return infix (pp_F0 (g[1]), g[0], pp_E0 (g[2]));
  else return pp_E1 (g);
}

generic
mmx_printer::pp_E1 (const generic& g) {
  if (is_func (g, GEN_LAMBDA) || is_func (g, GEN_MACRO)) {
    if (new_lambda_style) {
      vector<generic> v= compound_to_vector (g);
      generic t= gen (GEN_TUPLE, range (v, 1, N(v) - 1));
      generic b= g[N(g)-1];
      if (is_func (b, GEN_TYPE, 2)) { t= gen (GEN_TYPE, t, b[2]); b= b[1]; }
      generic d= (is_C0 (b)? pp_C0 (b): pp_E0 (b));
      return concat (keyword (g[0], pp_E0 (t)), pp_spc (), keyword ("do", d));
    }
    else {
      generic a= pp_E0 (g[1]);
      if (N(g) == 4) a= infix (a, ":", pp_E0 (g[3]));
      generic b= (is_C0 (g[2])? pp_C0 (g[2]): pp_E0 (g[2]));
      return concat (keyword (g[0], a), pp_spc (), keyword ("do", b));
    }
  }
  else if (is_func (g, GEN_MAPSTO, 2))
    return infix (pp_E2 (g[1]), g[0], pp_E2 (g[2]));
  else return pp_E2 (g);
}

generic
mmx_printer::pp_E2 (const generic& g) {
  if (is_func (g, GEN_LESSLESS, 2))
    return infix (pp_Lflux (g[1]), g[0], pp_F0 (g[2]));
  else if (is_func (g, GEN_GTRGTR, 2))
    return infix (pp_F0 (g[1]), g[0], pp_Rflux (g[2]));
  else return pp_F0 (g);
}

generic
mmx_printer::pp_Lflux (const generic& g) {
  if (is_func (g, GEN_LESSLESS, 2))
    return infix (pp_Lflux (g[1]), g[0], pp_F0 (g[2]));
  else return pp_F0 (g);
}

generic
mmx_printer::pp_Rflux (const generic& g) {
  if (is_func (g, GEN_GTRGTR, 2))
    return infix (pp_F0 (g[1]), g[0], pp_Rflux (g[2]));
  else return pp_F0 (g);
}

/******************************************************************************
* Formulas
******************************************************************************/

generic
mmx_printer::pp_F0 (const generic& g) {
  if (is_func (g, GEN_IMPLIES, 2) ||
      is_func (g, GEN_EQUIV, 2))
    return infix (pp_F1 (g[1]), g[0], pp_F1 (g[2]));
  else return pp_F1 (g);
}

generic
mmx_printer::pp_F1 (const generic& g) {
  if (is_func (g, GEN_SEQOR, 2))
    return infix (pp_Seqors (g[1]), g[0], pp_Seqors (g[2]));
  else if (is_func (g, GEN_OR, 2))
    return infix (pp_Ors (g[1]), g[0], pp_Ors (g[2]));
  else if (is_func (g, GEN_XOR, 2))
    return infix (pp_Xors (g[1]), g[0], pp_Xors (g[2]));
  else return pp_F2 (g);
}

generic
mmx_printer::pp_Seqors (const generic& g) {
  if (is_func (g, GEN_SEQOR, 2))
    return infix (pp_Seqors (g[1]), g[0], pp_Seqors (g[2]));
  else return pp_F2 (g);
}

generic
mmx_printer::pp_Ors (const generic& g) {
  if (is_func (g, GEN_OR, 2))
    return infix (pp_Ors (g[1]), g[0], pp_Ors (g[2]));
  else return pp_F2 (g);
}

generic
mmx_printer::pp_Xors (const generic& g) {
  if (is_func (g, GEN_XOR, 2))
    return infix (pp_Xors (g[1]), g[0], pp_Xors (g[2]));
  else return pp_F2 (g);
}

generic
mmx_printer::pp_F2 (const generic& g) {
  if (is_func (g, GEN_AND, 2))
    return infix (pp_Ands (g[1]), g[0], pp_Ands (g[2]));
  else if (is_func (g, GEN_SEQAND, 2))
    return infix (pp_Seqands (g[1]), g[0], pp_Seqands (g[2]));
  else return pp_F3 (g);
}

generic
mmx_printer::pp_Seqands (const generic& g) {
  if (is_func (g, GEN_SEQAND, 2))
    return infix (pp_Seqands (g[1]), g[0], pp_Seqands (g[2]));
  else return pp_F3 (g);
}

generic
mmx_printer::pp_Ands (const generic& g) {
  if (is_func (g, GEN_AND, 2) || is_func (g, GEN_SEQAND, 2))
    return infix (pp_Ands (g[1]), g[0], pp_Ands (g[2]));
  else return pp_F3 (g);
}

generic
mmx_printer::pp_F3 (const generic& g) {
  if (is_func (g, GEN_EQUAL, 2) ||
      is_func (g, GEN_UNEQUAL, 2) ||
      is_func (g, GEN_LESS, 2) ||
      is_func (g, GEN_LESSEQ, 2) ||
      is_func (g, GEN_GTR, 2) ||
      is_func (g, GEN_GTREQ, 2))
    return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
  else if (is_func (g, GEN_TYPE, 2))
    return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
  else if (is_func (g, GEN_IN, 2) && is_func (g[1], GEN_TYPE, 2))
    return infix (pp_F3 (g[1]), g[0], pp_T0 (g[2]));
  else if (is_func (g, GEN_IN, 2))
    return infix (pp_T0 (g[1]), g[0], pp_T0 (g[2]));
  else return pp_T0 (g);
}

/******************************************************************************
* Terms
******************************************************************************/

generic
mmx_printer::pp_T0 (const generic& g) {
  if (is_func (g, GEN_TRANSTYPE, 2) ||
      is_func (g, GEN_CONVERTS, 2))
    return infix (pp_T0 (g[1]), g[0], pp_T1 (g[2]));
  else if ((is_func (g, GEN_COERCE, 2) ||
            (is_func (g, GEN_COERCE_TYPE) && N(g) > 2)) &&
           mmx_abbreviate_coerce) {
    // FIXME: this temporary hack avoids us to print huge type names
    generic op= GEN_TRANSTYPE;
    if (is_func (g, GEN_COERCE_TYPE)) op= "::>";
    if (is_func (g, GEN_COERCE_TYPE, 3)) op= ":+>";
    return infix (pp_T0 (g[1]), op, pp_T1 (g[2]));
  }
  else return pp_T1 (g);
}

generic
mmx_printer::pp_T1 (const generic& g) {
  if (is_func (g, GEN_INTO, 2) ||
      is_func (g, GEN_MAPSTO, 2))
    return infix (pp_T2 (g[1]), g[0], pp_T2 (g[2]));
  else return pp_T2 (g);
}

generic
mmx_printer::pp_T2 (const generic& g) {
  if (is_func (g, GEN_RANGE, 2) ||
      is_func (g, GEN_SCOPE, 2))
    return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
  else if (is_func (g, GEN_TO, 2))
    return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
  else if (is_func (g, GEN_DOWNTO, 2))
    return infix (pp_T3 (g[1]), g[0], pp_T3 (g[2]));
  else return pp_T3 (g);
}

static void
collect (vector<generic>& v, const generic& g, nat depth) {
  if (depth >= 16384) v << g;
  else if (is_func (g, GEN_PLUS, 2)) {
    collect (v, g[1], depth+1);
    collect (v, g[2], depth+1);
  }
  else if (is_func (g, GEN_MINUS, 2)) {
    collect (v, g[1], depth+1);
    v << gen (GEN_MINUS, g[2]);
  }
  else v << g;
}

static vector<generic>
collect (const generic& g) {
  vector<generic> v;
  collect (v, g, 0);
  vector<generic> w;
  for (nat i=0; i<N(v); i++)
    if (is_func (v[i], GEN_PLUS, 2) || is_func (v[i], GEN_MINUS, 2))
      w << collect (v[i]);
    else w << v[i];
  return w;
}

generic
mmx_printer::pp_T3 (const generic& g) {
  if (is_func (g, GEN_PLUS, 2) || is_func (g, GEN_MINUS, 2)) {
    vector<generic> v= collect (g);
    for (nat i=0; i<N(v); i++)
      if (is_func (v[i], GEN_MINUS, 1))
        v[i]= gen (GEN_MINUS, pp_T4 (v[i][1]));
      else v[i]= pp_T3 (v[i]);
    return bigop (GEN_PLUS, v);
  }
  else return pp_T4 (g);
}

generic
mmx_printer::pp_T4 (const generic& g) {
  if (is_func (g, GEN_TIMES, 2) ||
      is_func (g, GEN_COMPOSE, 2) ||
      is_func (g, GEN_APPEND, 2))
    return infix (pp_T4 (g[1]), g[0], pp_T4 (g[2]));
  else if (is_func (g, GEN_OVER, 2) ||
           is_func (g, GEN_SIZE, 2) ||
           is_func (g, "%", 2) ||
           is_func (g, "&", 2))
    return infix (pp_T4 (g[1]), g[0], pp_T5 (g[2]));
  else if (is_func (g, GEN_DIV, 2))
    return infix (pp_T4 (g[1]), "div", pp_T5 (g[2]));
  else if (is_func (g, GEN_QUO, 2))
    return infix (pp_T4 (g[1]), "quo", pp_T5 (g[2]));
  else if (is_func (g, GEN_REM, 2))
    return infix (pp_T4 (g[1]), "rem", pp_T5 (g[2]));
  else if (is_func (g, GEN_MOD, 2))
    return infix (pp_T4 (g[1]), "mod", pp_T5 (g[2]));
  else return pp_T5 (g);
}

generic
mmx_printer::pp_T5 (const generic& g) {
  if (is_func (g, GEN_MINUS, 1))
    return prefix (g[0], pp_R0 (g[1]));
  else if (is_func (g, GEN_EXPLODE, 1) ||
           is_func (g, GEN_SIZE, 1) ||
           is_func (g, "%", 1) ||
           is_func (g, "&", 1) ||
           is_func (g, GEN_NOT, 1))
    return prefix (g[0], pp_T5 (g[1]));
  else if (is<literal> (g) && g != GEN_MINUS &&
           starts (literal_to_string (g), "-"))
    return pp_verb (literal_to_string (g));
  else return pp_R0 (g);
}

/******************************************************************************
* Radicals
******************************************************************************/

generic
mmx_printer::pp_R0 (const generic& g) {
  return pp_R1 (g);
}

generic
mmx_printer::pp_R1 (const generic& g) {
  if (is_func (g, GEN_POWER, 2) || is_func (g, GEN_FILL, 2))
    return infix (pp_R2 (g[1]), g[0], pp_R2 (g[2]));
  else return pp_R2 (g);
}

generic
mmx_printer::pp_R2 (const generic& g) {
  if (is_func (g, GEN_FACTORIAL, 1))
    return postfix (pp_R2 (g[1]), "!");
  else if (is_func (g, GEN_PRIME, 1))
    return postfix (pp_R2 (g[1]), "'");
  else if (is_func (g, GEN_BACKPRIME, 1))
    return postfix (pp_R2 (g[1]), "`");
  else if (is_func (g, GEN_STAR, 1))
    return postfix (pp_R2 (g[1]), "*");
  else if (is_func (g, GEN_HAT, 1))
    return postfix (pp_R2 (g[1]), "^");
  else if (is_func (g, GEN_TILDA, 1))
    return postfix (pp_R2 (g[1]), "~");
  else if (is_func (g, GEN_QUOTE, 1) || is_func (g, GEN_BACKQUOTE, 1)) {
    if (is<literal> (g[1])) // this test should be further improved
      return prefix (g[0], pp_verb (literal_to_string (g[1])));
    else if (is_func (g[1], GEN_QUOTE, 1) || is_func (g[1], GEN_BACKQUOTE, 1))
      return prefix (g[0], pp_E0 (g[1]));
    else return prefix (g[0], bracket ("(", pp_E0 (g[1]), ")"));
  }
  else if (N(g) == 2 &&
           is<literal> (g[0]) &&
           starts (literal_to_string (g[0]), "."))
    return concat (pp_R2 (g[1]), pp_verb (literal_to_string (g[0])));
  else if (is_func (g, GEN_ACCESS))
    return operate (pp_R2 (g[1]), bracket ("[", pp_E0s (g, 2), "]"));
  else if ((is<compound> (g) && is_applicable (g[0])) ||
           (!is_nil (gl) && exact_eq (read_car (gl), g))) {
    if (is<literal> (g)) return pp_verb (literal_to_string (g));
      else if (is<literal> (g[0])) {
      string op= literal_to_string (g[0]);
      if (starts (op, "$") || starts (op, "tm$")) {
        vector<generic> v= vec<generic> (g[0]);
        for (nat i=1; i<N(g); i++) v << pp_E0 (g[i]);
        return vector_to_compound (v);
      }
    }
    return operate (pp_R2 (g[0]), bracket ("(", pp_E0s (g, 1), ")"));
  }
  else return pp_R3 (g);
}

generic
mmx_printer::pp_R3 (const generic& g) {
  if (is<literal> (g) && !starts (literal_to_string (g), "-"))
    return pp_verb (literal_to_string (g));
  else if (is_func (g, GEN_SQTUPLE))
    return bracket ("[", pp_E0s (g, 1), "]");
  else if (is_func (g, GEN_TUPLE))
    return bracket ("(", pp_E0s (g, 1), ")");
  else if (is_func (g, GEN_ROW))
    return pp_E0s (g, 1);
  else if (is_func (g, GEN_WHERE) || is_func (g, GEN_VWHERE))
    return bracket ("(", pp_where (g), ")");
  else {
    gl= cons (g, gl);
    generic r= pp_E0 (g);
    gl= read_cdr (gl);
    return bracket ("(", r, ")");
  }
}

/******************************************************************************
* Interface
******************************************************************************/

generic
print_mmx (const generic& g) {
  vector<generic> v;
  mmx_printer pp;
  if (is_func (g, GEN_BEGIN))
    for (nat i=1; i<N(g); i++)
      v << pp.pp_C0 (g[i], i<N(g)-1);
  else if (is_C0 (g)) v << pp.pp_C0 (g);
  else v << pp.pp_E0 (g);
  return concat (v);
}

string
as_mmx (const generic& g) {
  return serialize (print_mmx (g));
}

string
flatten_as_mmx (const generic& g) {
  generic f= as_generic (flatten (g));
  return as_mmx (f);
}

string
output_as_mmx (const generic& g) {
  if (math_mode) {
    string r;
    r << DATA_BEGIN << "scheme:";
    r << flatten_as_texmacs_scheme (g);
    r << DATA_END;
    return r;
  }
  else {
    generic f= as_generic (flatten (g));
    return as_mmx (f);
  }
}

string
string_as_mmx (const string& s) {
  //if (math_mode) { ... }
  return s;
}

} // namespace mmx