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

Go to the documentation of this file.

/******************************************************************************
* MODULE     : lisp_parser.cpp
* DESCRIPTION: Parsing lisp expressions
* COPYRIGHT  : (C) 2005  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/string.hpp>
#include <basix/vector.hpp>
#include <basix/compound.hpp>
namespace mmx {

static generic
parse_lisp (const string& s, nat& pos, bool unquote_flag, bool fun_flag) {
  while (pos < N(s) && s[pos] == ' ') pos++;
  if (s[pos] == '(') {
    vector<generic> v;
    pos++;
    while (pos < N(s) && s[pos] != ')') {
      bool fun= (N(v) == 0);
      v << parse_lisp (s, pos, unquote_flag, fun);
      while (pos < N(s) && s[pos] == ' ') pos++;
    }
    if (pos < N(s)) pos++;
    return vector_to_compound (v);
  }
  else if (unquote_flag && !fun_flag && pos < N(s) && s[pos] == '\"') {
    nat start= pos;
    pos++;
    while (pos < N(s) && s[pos] != '\"')
      if (s[pos] == '\\') pos += 2;
      else pos++;
    if (pos < N(s)) pos++;
    return generic (unquote (s (start, pos)));
  }
  else {
    nat start= pos;
    while (pos < N(s) && s[pos] != ' ' && s[pos] != '(' && s[pos] != ')')
      pos++;
    return generic (s (start, pos));
  }
}

generic
parse_lisp (const string& s, bool unquote_flag) {
  nat pos= 0;
  return parse_lisp (s, pos, unquote_flag, false);
}

} // namespace mmx