lispreader.java

A framework written in Java for implementing high-level and dynamic languages, compiling them into J

package gnu.kawa.lispexpr;
import gnu.text.*;
import gnu.mapping.*;
import gnu.lists.*;
import gnu.math.*;
import gnu.expr.*;

/** A Lexer for reading S-expressions in generic Lisp-like syntax.
 * This class may have outlived its usefulness: It's mostly just a
 * wrapper around a LineBufferedReader plus a helper token-buffer.
 * The functionality should be moved to ReadTable, though it is
 * unclear what to do about the tokenBuffer.
 */

public class LispReader extends Lexer
{
  public LispReader(LineBufferedReader port)
  {
    super(port);
  }

  public LispReader(LineBufferedReader port, SourceMessages messages)
  {
    super(port, messages);
  }

  /** Resolve a unit name, if possible.
   * Returns null if the unit name is unknown. */
  public static Object lookupUnit (String name)
  {
    name = (name + "$unit").intern();
    try
      {
	return Environment.getCurrent().getChecked(name);
      }
    catch (UnboundLocationException ex)
      {
	return name;
      }
  }

  /** Read a #|...|#-style comment (which may contain other nested comments).
    * Assumes the initial "#|" has already been read.
    */
  final public void readNestedComment (char c1, char c2)
       throws java.io.IOException, SyntaxException
  {
    int commentNesting = 1;
    int startLine = port.getLineNumber();
    int startColumn = port.getColumnNumber();
    do
      {
	int c = read ();
	if (c == '|')
	  {
	    c = read();
	    if (c == c1)
	      commentNesting--;
	  }
	else if (c == c1)
	  {
	    c = read();
	    if (c == c2)
	      commentNesting++;
	  }
	if (c < 0)
	  {
            eofError("unexpected end-of-file in " + c1 + c2
                     + " comment starting here",
                     startLine + 1, startColumn - 1);
	    return;
	  }
      } while (commentNesting > 0);
  }

  /** Get specification of how symbols should be case-folded.
    * @return Either 'P' (means preserve case), 'U' (upcase),
    * 'D' (downcase, or 'I' (invert case).
    */
  static char getReadCase()
  {
    char read_case;
    try
      {
	String read_case_string
	  = Environment.getCurrent().get("symbol-read-case", "P").toString();
	read_case = read_case_string.charAt(0);
	if (read_case == 'P') ;
	else if (read_case == 'u')
	  read_case = 'U';
	else if (read_case == 'd' || read_case == 'l' || read_case == 'L')
	  read_case = 'D';
	else if (read_case == 'i')
	  read_case = 'I';
      }
    catch (Exception ex)
      {
	read_case = 'P';
      }
    return read_case;
  }

  public Object readValues (int ch,  ReadTable rtable)
      throws java.io.IOException, SyntaxException
  {
    return readValues(ch, rtable.lookup(ch), rtable);
  }

  /** May return zero or multiple values. */
  public Object readValues (int ch, ReadTableEntry entry, ReadTable rtable)
      throws java.io.IOException, SyntaxException
  {
    // Step numbers refer to steps in section 2.2 of the HyperSpec.
    // Step 1:
    int startPos = tokenBufferLength;

    if (entry == null)
      {
	// Step 2:
	String err = ("invalid character #\\"+((char) ch));  // FIXME
	if (interactive) fatal(err);
	else error(err);
	return Values.empty;
      }
    int kind = entry.getKind();
    seenEscapes = false;
    switch (kind)
      {
      case ReadTable.WHITESPACE:
	// Step 3:
	return Values.empty;
      case ReadTable.TERMINATING_MACRO:
      case ReadTable.NON_TERMINATING_MACRO:
	Object value = entry.read(this, ch, -1);
	return value;
      case ReadTable.CONSTITUENT:
        if (ch == rtable.postfixLookupOperator)
          { // Force an initial ':' to be treated as a CONSTITUENT.
            tokenBufferAppend(ch);
            ch = read();
          }
      case ReadTable.SINGLE_ESCAPE: // Step 5:
      case ReadTable.MULTIPLE_ESCAPE: // Step 6:
      default:  // 
	break;
      }

    readToken(ch, getReadCase(), rtable);
    int endPos = tokenBufferLength;
    if (seenEscapes)
      return returnSymbol(startPos, endPos, rtable);
    else
      return handleToken(startPos, endPos, rtable);
  }

  public static final char TOKEN_ESCAPE_CHAR = '\uffff';

  /** If true, then tokenbuffer contains escaped characters.
   * These are prefixed (in the buffer) by TOKEN_ESCAPE_CHAR.
   */
  protected boolean seenEscapes;

  /** True if ":IDENTIFIER" should be treated as a keyword. */
  protected boolean initialColonIsKeyword = true;

  /** True if "IDENTIFIER:" should be treated as a keyword. */
  protected boolean finalColonIsKeyword = true;

  void readToken(int ch, char readCase, ReadTable rtable)
      throws java.io.IOException, SyntaxException
  {
    boolean inEscapes = false;
    for (;; ch = read())
      {
	if (ch < 0)
	  {
	    if (inEscapes)
	      eofError("unexpected EOF between escapes");
	    else
	      break;
	  }
	ReadTableEntry entry = rtable.lookup(ch);
	if (entry == null)
	  {
	    if (inEscapes)
	      {
		tokenBufferAppend(TOKEN_ESCAPE_CHAR);
		tokenBufferAppend(ch);
		continue;
	      }
	    unread(ch);
	    break;
	  }
	int kind = entry.getKind();
        if (ch == rtable.postfixLookupOperator && ! inEscapes
            && validPostfixLookupStart(rtable))
          kind = ReadTable.TERMINATING_MACRO;
                  
	if (kind == ReadTable.SINGLE_ESCAPE)
	  {
	    ch = read();
	    if (ch < 0)
	      eofError("unexpected EOF after single escape");
	    tokenBufferAppend(TOKEN_ESCAPE_CHAR);
	    tokenBufferAppend(ch);
	    seenEscapes = true;
	    continue;
	  }
	if (kind == ReadTable.MULTIPLE_ESCAPE)
	  {
	    inEscapes = ! inEscapes;
	    continue;
	  }
	if (inEscapes)
	  {
	    // Step 9:
	    tokenBufferAppend(TOKEN_ESCAPE_CHAR);
	    tokenBufferAppend(ch);
	  }
	else
	  {
	    // Step 8:
	    switch (kind)
	      {
	      case ReadTable.CONSTITUENT:
		// ... fall through ...
	      case ReadTable.NON_TERMINATING_MACRO:
		if (readCase == 'U'
		    || (readCase == 'I' && Character.isLowerCase((char) ch)))
		  ch = Character.toUpperCase((char) ch);
		else if (readCase == 'D'
			 || (readCase == 'I'
			     && Character.isUpperCase((char) ch)))
		  ch = Character.toLowerCase ((char) ch);
		tokenBufferAppend(ch);
		continue;
	      case ReadTable.MULTIPLE_ESCAPE:
		inEscapes = true;
		seenEscapes = true;
		continue;
	      case ReadTable.TERMINATING_MACRO:
		unread(ch);
		return;
	      case ReadTable.WHITESPACE:
		// if (readPreservingWhitespace) FIXME
		unread(ch);
		return;
	      }
	  }
      }
  }

  public Object readObject ()
      throws java.io.IOException, SyntaxException
  {
    char saveReadState = ((InPort) port).readState;
    int startPos = tokenBufferLength;
    ((InPort) port).readState = ' ';
    try
      {
        ReadTable rtable = ReadTable.getCurrent();
	for (;;)
	  {
	    int line = port.getLineNumber();
	    int column = port.getColumnNumber();
	    int ch = port.read();
	    if (ch < 0)
	      return Sequence.eofValue; // FIXME
            Object value = readValues(ch, rtable);
	    if (value == Values.empty)
	      continue;
	    return handlePostfix(value, rtable, line, column);
	  }
      }
    finally
      {
	tokenBufferLength = startPos;
	((InPort) port).readState = saveReadState;
      }
  }

  protected boolean validPostfixLookupStart (ReadTable rtable)
      throws java.io.IOException
  {
    int ch = port.peek();
    ReadTableEntry entry;
    if (ch < 0 || ch == ':' || (entry = rtable.lookup(ch)) == null
        || ch == rtable.postfixLookupOperator)
      return false;
    int kind = entry.getKind();
    return kind == ReadTable.CONSTITUENT
      || kind == ReadTable.NON_TERMINATING_MACRO
      || kind == ReadTable.MULTIPLE_ESCAPE
      || kind == ReadTable.SINGLE_ESCAPE;
  }

  Object handlePostfix (Object value, ReadTable rtable, int line, int column)
      throws java.io.IOException, SyntaxException
  {
    if (value == QuoteExp.voidExp)
      value = Values.empty;
    for (;;)
      {
        int ch = port.peek();
        if (ch < 0 || ch != rtable.postfixLookupOperator)
          break;
        // A kludge to map PreOpWord to ($lookup$ Pre 'Word).
        port.read();
        if (! validPostfixLookupStart(rtable))
          {
            unread();
            break;
          }
        ch = port.read();
        Object rightOperand = readValues(ch, rtable.lookup(ch), rtable);
        value = LList.list2(value,
                            LList.list2(LispLanguage.quote_sym, rightOperand));
        value = PairWithPosition.make(LispLanguage.lookup_sym, value,
                                      port.getName(), line+1, column+1);
      }
    return value;
  }

  private boolean isPotentialNumber (char[] buffer, int start, int end)
  {
    int sawDigits = 0;
    for (int i = start;  i < end;  i++)
      {
	char ch = buffer[i];
	if (Character.isDigit(ch))
	  sawDigits++;
	else if (ch == '-' || ch == '+')
	  {
	    if (i + 1 == end)
	      return false;
	  }
	else if (ch == '#')
	  return true;
	else if (Character.isLetter(ch) || ch == '/'
		 || ch == '_' || ch == '^')
 	  {
	    // CommonLisp defines _123 (and ^123) as a "potential number";
	    // most implementations seem to define it as a symbol.
	    // Scheme does defines it as a symbol.
	    if (i == start)
	      return false;
	  }
	else if (ch != '.')
	  return false;
      }
    return sawDigits > 0;
  }

  static final int SCM_COMPLEX = 1;
  public static final int SCM_NUMBERS = SCM_COMPLEX;

  /** Parse a number.
   * @param buffer contains the characters of the number
   * @param start startinging index of the number in the buffer
   * @param count number of characters in buffer to use
   * @param exactness either 'i' or 'I' force an inexact result,
   *   either 'e' or 'E' force an exact result,
   *   '\0' yields an inact or inexact depending on the form of the literal,
   *   while ' ' is like '\0' but does not allow more exactness specifiers.
   * @param radix the number base to use or 0 if unspecified
   * @return the number if a valid number; null or a String-valued error
   *   message if if there was some error parsing the number.
   */
  public static Object parseNumber(char[] buffer, int start, int count,
				   char exactness, int radix, int flags)
  {
    int end = start + count;
    int pos = start;
    if (pos >= end)
      return "no digits";
    char ch = buffer[pos++];
    while (ch == '#')
      {
	if (pos >= end)
	  return "no digits";
	ch = buffer[pos++];
	switch (ch)
	  {
	  case 'b':  case 'B':
	    if (radix != 0)
	      return "duplicate radix specifier";
	    radix = 2;
	    break;
	  case 'o':  case 'O':
	    if (radix != 0)
	      return "duplicate radix specifier";
	    radix = 8;
	    break;
	  case 'd':  case 'D':
	    if (radix != 0)
	      return "duplicate radix specifier";
	    radix = 10;
	    break;
	  case 'x':  case 'X':
	    if (radix != 0)
	      return "duplicate radix specifier";
	    radix = 16;
	    break;
	  case 'e':  case 'E':
	  case 'i':  case 'I':
	    if (exactness != '\0')
	      {
		if (exactness == ' ')
		  return "non-prefix exactness specifier";
		else
		  return "duplicate exactness specifier";
	      }
	    exactness = ch;
	    break;