
/******************************************************************************
* MODULE     : scheme.gen.cc
* DESCRIPTION: conversion between trees and guile/scheme expressions
* COPYRIGHT  : (C) 1999  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.
******************************************************************************/

#module code_scheme

/******************************************************************************
* Converting scheme trees to strings
******************************************************************************/

static string
slash (string s) {
  int i, n= N(s);
  string r;
  for (i=0; i<n; i++)
    switch (s[i]) {
    case '(':
    case ')':
    case ' ':
    case '\'':
      if ((n<2) || (s[0]!='\042') || (s[n-1]!='\042')) r << "\\";
      r << s[i];
      break;
    case '\\':
      r << "\\" << s[i];
      break;
    case '\042':
      if (((i==0) && (s[n-1]=='\042')) ||
	  ((i==(n-1)) && (s[0]=='\042')))
	r << s[i];
      else r << "\\" << s[i];
      break;
    case ((char) 0):
      r << "\\0";
      break;
    case '\t':
      r << "\\t";
      break;
    case '\n':
      r << "\\n";
      break;
    default:
      r << s[i];
    }
  return r;
}

static void
scheme_tree_to_string (string& out, scheme_tree p) {
  if (!is_tuple (p)) out << slash (p->label);
  else {
    if (is_tuple (p, "\'", 1)) {
      out << "\'";
      scheme_tree_to_string (out, p[1]);
    }
    else {
      int i, n= N(p);
      out << "(";
      for (i=0; i<n; i++) {
	if (i>0) out << " ";
	scheme_tree_to_string (out, p[i]);
      }
      out << ")";
    }
  }
}

string
scheme_tree_to_string (scheme_tree p) {
  string out;
  scheme_tree_to_string (out, p);
  return out;
}

/******************************************************************************
* Converting strings to scheme trees
******************************************************************************/

static bool
is_spc (char c) {
  return (c==' ') || (c=='\t') || (c=='\n');
}

static string
unslash (string s, int start, int end) {
  int i;
  string r;
  for (i=start; i<end; i++)
    if ((s[i]=='\\') && ((i+1)<end))
      switch (s[++i]) {
      case '0': r << ((char) 0); break;
      case 'n': r << '\n'; break;
      case 't': r << '\t'; break;
      default: r << s[i];
      }
    else r << s[i];
  return r;
}

static scheme_tree
string_to_scheme_tree (string s, int& i) {
  for (; i<N(s); i++)
    switch (s[i]) {

    case ' ':
    case '\t':
    case '\n':
      break;

    case '(':
      {
	scheme_tree p (TUPLE);
	i++;
	while (TRUE) {
	  while ((i<N(s)) && is_spc(s[i])) i++;
	  if ((i==N(s)) || (s[i]==')')) break;
	  p << string_to_scheme_tree (s, i);
	}
	if (i<N(s)) i++;
	return p;
      }

    case '\'':
      i++;
      return scheme_tree (TUPLE, "\'", string_to_scheme_tree (s, i));
      
    case '\"':
      { // "
	int start= i++;
	while ((i<N(s)) && (s[i]!='\"')) { // "
	  if ((i<N(s)-1) && (s[i]=='\\')) i++;
	  i++;
	}
	if (i<N(s)) i++;
	return scheme_tree (unslash (s, start, i));
      }

    case ';':
      while ((i<N(s)) && (s[i]!='\n')) i++;
      break;

    default:
      {
	int start= i;
	while ((i<N(s)) && (!is_spc(s[i])) && (s[i]!='(') && (s[i]!=')')) {
	  if ((i<N(s)-1) && (s[i]=='\\')) i++;
	  i++;
	}
	return scheme_tree (unslash (s, start, i));
      }
    }

  return "";
}

scheme_tree
string_to_scheme_tree (string s) {
  int i=0;
  return string_to_scheme_tree (s, i);
}

scheme_tree
block_to_scheme_tree (string s) {
  scheme_tree p (TUPLE);
  int i=0;
  while ((i<N(s)) && (is_spc (s[i]) || s[i]==')')) i++;
  while (i<N(s)) {
    p << string_to_scheme_tree (s, i);
    while ((i<N(s)) && (is_spc (s[i]) || s[i]==')')) i++;
  }
  return p;
}

/******************************************************************************
* Conversion between trees and scheme trees
******************************************************************************/

scheme_tree
tree_to_scheme_tree (tree t) {
  if (is_atomic (t)) return "\"" * t->label * "\"";
  else if (is_func (t, EXPAND) && is_atomic (t[0]) &&
	   (!CONSTRUCTOR_CODE->contains (t[0]->label))) {
    int i, n= N(t);
    tree u (TUPLE, n);
    u[0]= copy (t[0]);
    for (i=1; i<n; i++)
      u[i]= tree_to_scheme_tree (t[i]);
    return u;    
  }
  else {
    int i, n= N(t);
    tree u (TUPLE, n+1);
    u[0]= copy (CONSTRUCTOR_NAME [(int) L(t)]);
    for (i=0; i<n; i++)
      u[i+1]= tree_to_scheme_tree (t[i]);
    return u;
  }
}

tree
scheme_tree_to_tree (scheme_tree t, hashmap<string,int> codes) {
  if (is_atomic (t)) return unquote (t->label);
  else if ((N(t) == 0) || is_compound (t[0])) {
    cerr << "\nTeXmacs] The tree was " << t << "\n";
    fatal_error ("bad TeXmacs tree", "scheme_tree_to_tree");
    return ""; // avoids error message when C++ compiler behaves badly
  }
  else {
    int i, n= N(t);
    tree_label code= (tree_label) codes [t[0]->label];
    if (code == UNKNOWN) {
      tree u (EXPAND, n);
      u[0]= copy (t[0]);
      for (i=1; i<n; i++)
	u[i]= scheme_tree_to_tree (t[i], codes);
      return u;
    }
    else {
      tree u (code, n-1);
      for (i=1; i<n; i++)
	u[i-1]= scheme_tree_to_tree (t[i], codes);
      return u;
    }
  }
}

tree
scheme_tree_to_tree (scheme_tree t) {
  return scheme_tree_to_tree (t, CONSTRUCTOR_CODE);
}

/******************************************************************************
* Conversion between trees and scheme strings
******************************************************************************/

string
tree_to_scheme (tree t) {
  return scheme_tree_to_string (tree_to_scheme_tree (t));
}

string
tree_to_scheme_document (tree t) {
  return scheme_tree_to_string (tree_to_scheme_tree (t));
}

tree
scheme_to_tree (string s) {
  return scheme_tree_to_tree (string_to_scheme_tree (s));
}

tree
scheme_document_to_tree (string s) {
  if (starts (s, "(document (apply \"TeXmacs\" ") ||
      starts (s, "(document (expand \"TeXmacs\" ") ||
      starts (s, "(document (TeXmacs "))
    {
      int i, begin=27;
      if (starts (s, "(document (expand \"TeXmacs\" ")) begin= 28;
      if (starts (s, "(document (TeXmacs ")) begin= 19;
      for (i=begin; i<N(s); i++)
	if (s[i] == ')') break;
      path version= as_path (s (begin, i));
      tree t  = string_to_scheme_tree (s);
      tree doc= scheme_tree_to_tree (t, get_codes (version));
      if (!is_document (doc)) return "error";
      return upgrade (doc, version);
    }
  return "error";
}

#endmodule // code_scheme
