lispreader.java

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

	  default:
	    int value = 0;
	    for (;;)
	      {
		int dig = Character.digit(ch, 10);
		if (dig < 0)
		  break;
		value = 10 * value + dig;
		if (pos >= end)
		  return "missing letter after '#'";
		ch = buffer[pos++];
	      }
	    if (ch == 'R' || ch == 'r')
	      {
		if (radix != 0)
		  return "duplicate radix specifier";
		if (value < 2 || value > 35)
		  return "invalid radix specifier";
		radix = value;
		break;
	      }
	    return "unknown modifier '#" + ch + '\'';
	  }
	if (pos >= end)
	  return "no digits";
	ch = buffer[pos++];
      }
    if (exactness == '\0')
      exactness = ' ';
    if (radix == 0)
      {
	for (int i = count;  ; )
	  {
	    if (--i < 0)
	      {
		// FIXME - should get *read-base* in CommonLisp:
		// radix = *read_base*;
		radix = 10;
		break;
	      }
	    if (buffer[start+i] == '.')
	      {
		radix = 10;
		break;
	      }
	  }
      }

    boolean negative = ch == '-';
    boolean numeratorNegative = negative;
    if (ch == '-' || ch == '+')
      {
	if (pos >= end)
	  return "no digits following sign";
	ch = buffer[pos++];
      }

    // Special case for '+i' and '-i'.
    if ((ch == 'i' || ch == 'I') && pos == end && start == pos - 2
	&& (flags & SCM_COMPLEX) != 0)
      {
	char sign = buffer[start];
	if (sign != '+' && sign != '-')
	  return "no digits";
	if (exactness == 'i' || exactness == 'I')
	  return new DComplex(0, negative ? -1 : 1);
	return negative ? Complex.imMinusOne() : Complex.imOne();
      }

    int realStart = pos - 1;
    boolean hash_seen = false;
    char exp_seen = '\000';
    int digits_start = -1;
    int decimal_point = -1;
    boolean copy_needed = false;
    boolean underscore_seen = false;
    IntNum numerator = null;
    long lvalue = 0;
  loop:
    for (;;)
      {
	int digit = Character.digit(ch, radix);
	if (digit >= 0)
	  {
	    if (hash_seen && decimal_point < 0)
	      return "digit after '#' in number";
	    if (digits_start < 0)
	      digits_start = pos - 1;
	    lvalue = radix * lvalue + digit;
	  }
	else
	  {
	    switch (ch)
	      {
		/*
	      case '_':
		underscore_seen = true;
		break;
		*/
		/*
	      case '#':
		if (radix != 10)
		  return "'#' in non-decimal number";
		if (digits_start < 0)
		  return "'#' with no preceeding digits in number";
		hash_seen = true;
		break;
		*/
	      case '.':
		if (decimal_point >= 0)
		  return "duplicate '.' in number";
		if (radix != 10)
		  return "'.' in non-decimal number";
		decimal_point = pos - 1;
		break;
	      case 'e': case 's': case 'f': case 'd': case 'l':
	      case 'E': case 'S': case 'F': case 'D': case 'L':
		if (pos == end || radix != 10)
		  {
		    pos--;
		    break loop;
		  }
		char next = buffer[pos];
		if (next == '+' || next == '-')
		  {
		    if (++ pos >= end
			|| Character.digit(buffer[pos], 10) < 0)
		      return "missing exponent digits";
		  }
		else if (Character.digit(next, 10) < 0)
		  {
		    pos--;
		    break loop;
		  }
		if (exp_seen != '\000')
		  return "duplicate exponent";
		if (radix != 10)
		  return "exponent in non-decimal number";
		if (digits_start < 0)
		  return "mantissa with no digits";
		exp_seen = ch;
		for (;;)
		  {
		    pos++;
		    if (pos >= end || Character.digit(buffer[pos], 10) < 0)
		      break loop;
		  }
	      case '/':
		if (numerator != null)
		  return "multiple fraction symbol '/'";
		if (digits_start < 0)
		  return "no digits before fraction symbol '/'";
		if (exp_seen != '\000' || decimal_point >= 0)
		  return "fraction symbol '/' following exponent or '.'";
		numerator = valueOf(buffer, digits_start, pos - digits_start,
				    radix, negative, lvalue);
		digits_start = -1;
		lvalue = 0;
		negative = false;
		hash_seen = false;
		underscore_seen = false;
		break;
	      default:
		pos--;
		break loop;
	      }
	  }
	if (pos == end)
	  break;
	ch = buffer[pos++];
      }

    if (digits_start < 0)
      return "no digits";

    if (hash_seen || underscore_seen)
      {
	// FIXME make copy, removing '_' and replacing '#' by '0'.
      }

    boolean inexact = (exactness == 'i' || exactness == 'I'
		       || (exactness == ' ' && hash_seen));
    RealNum number = null;
    if (exp_seen != '\000' || decimal_point >= 0)
      {
	if (digits_start > decimal_point && decimal_point >= 0)
	  digits_start = decimal_point;
	if (numerator != null)
	  return "floating-point number after fraction symbol '/'";
	String str = new String(buffer, digits_start, pos - digits_start);
	double d = Convert.parseDouble(str);
	number = new DFloNum(negative ? - d : d);
      }
    else
      {
	IntNum iresult = valueOf(buffer, digits_start, pos - digits_start,
				 radix, negative, lvalue);
	if (numerator == null)
	  number = iresult;
	else
	  {
	    // Check for zero denominator values: 0/0, n/0, and -n/0
	    // (i.e. NaN, Infinity, and -Infinity).
	    if (iresult.isZero ())
	      {
		boolean numeratorZero = numerator.isZero();
		if (inexact)
		  number =  new DFloNum ((numeratorZero ? Double.NaN
					  : numeratorNegative ? Double.NEGATIVE_INFINITY
					  : Double.POSITIVE_INFINITY));
		else if (numeratorZero)
		  return "0/0 is undefined";
		else
		  number = RatNum.make(numerator, iresult);
	      }
	    else
	      {
		number = RatNum.make(numerator, iresult);
	      }
	  }
	if (inexact && number.isExact())
	  // We want #i-0 or #i-0/1 to be -0.0, not 0.0.
	  number = new DFloNum(numeratorNegative && number.isZero() ? -0.0
			       : number.doubleValue());
      }

    if (exactness == 'e' || exactness == 'E')
      number = number.toExact();

    if (pos < end)
      {
	ch = buffer[pos++];

	if (ch == '@')
	  { /* polar notation */
	    Object angle = parseNumber(buffer, pos, end - pos,
				       exactness, 10, flags);
	    if (angle instanceof String)
	      return angle;
	    if (! (angle instanceof RealNum))
	      return "invalid complex polar constant";
	    RealNum rangle = (RealNum) angle;
	    /* r4rs requires 0@1.0 to be inexact zero, even if (make-polar
	     * 0 1.0) is exact zero, so check for this case.  */
	    if (number.isZero () && !rangle.isExact ())
	      return new DFloNum (0.0);

	    return Complex.polar (number, rangle);
	  }

	if (ch == '-' || ch == '+')
	  {
	    pos--;
	    Object imag = parseNumber(buffer, pos, end - pos,
				      exactness, 10, flags);
	    if (imag instanceof String)
	      return imag;
	    if (! (imag instanceof Complex))
	      return "invalid numeric constant ("+imag+")";
	    Complex cimag = (Complex) imag;
	    RealNum re = cimag.re();
	    if (! re.isZero())
	      return "invalid numeric constant";
	    return Complex.make(number, cimag.im());
	  }

	int lcount = 0;
	for (;;)
	  {
	    if (! Character.isLetter(ch))
	      {
		pos--;
		break;
	      }
	    lcount++;
	    if (pos == end)
	      break;
	    ch = buffer[pos++];
	  }

	if (lcount == 1)
	  {
	    char prev = buffer[pos-1];
	    if (prev == 'i' || prev == 'I')
	      {
		if (pos < end)
		  return "junk after imaginary suffix 'i'";
		return Complex.make(IntNum.zero (), number);
	      }
	  }
	if (lcount > 0)
	  {
	    Object unit = null;
	    for (;;)
	      {
		String word = new String(buffer, pos - lcount, lcount);
		Object u = lookupUnit(word);

		int power = 1;
		if (pos < end)
		  {
		    ch = buffer[pos];
		    if (ch == '^' && ++pos < end)
		      ch = buffer[pos];
		    boolean neg = ch == '-';
		    if ((ch == '-' || ch == '+') && ++pos < end)
		      ch = buffer[pos];
		    power = -1;
		    for (;;)
		      {
			int d = Character.digit(ch, 10);
			if (d < 0)
			  {
			    if (power < 0)
			      return "junk after unit name";
			    break;
			  }
			power = power < 0 ? d  : 10 * power + d;
			if (++pos == end)
			  break;
			if (power > 1000000)
			  return "unit power too large";
			ch = buffer[pos];
		      }
		    if (neg) power = -power;
		  }

		// "expt" and "*" are too open to name clashes. FIXME.
		if (power != 1)
		  {
		    if (u instanceof Unit)
		      u = Unit.pow((Unit) u, power);
		    else
		      u = LList.list3("expt", u, IntNum.make(power));
		  }
		if (unit == null)
		  unit = u;
		else if (u instanceof Unit && unit instanceof Unit)
		  unit = Unit.times((Unit) unit, (Unit) u);
		else
		  unit = LList.list3("*", unit, u);
		if (pos >= end)
		  break;
		ch = buffer[pos++];
		if (ch == '*')
		  {
		    if (pos == end)
		      return "end of token after '*'";
		    ch = buffer[pos++];
		  }
		lcount = 0;
		for (;;)
		  {
		    if (! Character.isLetter(ch))
		      {
			pos--;
			break;
		      }
		    lcount++;
		    if (pos == end)
		      break;
		    ch = buffer[pos++];
		  }
		if (lcount == 0)
		  return "excess junk after unit";
	      }

	    if (unit == null)
	      return "expected unit";
	    else if (unit instanceof Unit)
	      return Quantity.make(number, (Unit) unit);
	    else
	      return LList.list3("*", number, unit);
	  }
	else
	  return "excess junk after number";
	
      }
    return number;
  }

  private static IntNum valueOf (char[] buffer, int digits_start,
				 int number_of_digits,
				 int radix, boolean negative,
				 long lvalue)
  {
    // It turns out that if number_of_digits + radix <= 28
    // then the value will fit in a long without overflow,
    // so we can use the value calculated in lvalue.
    if (number_of_digits + radix <= 28)
      return IntNum.make(negative ? - lvalue : lvalue);
    else
      return IntNum.valueOf(buffer, digits_start, number_of_digits,
			    radix, negative);
  }

  protected Object returnSymbol(int startPos, int endPos, ReadTable rtable)
  {
    char readCase = getReadCase();
    if (readCase == 'I')
      {
	int upperCount = 0;
	int lowerCount = 0;
	for (int i = startPos;  i < endPos;  i++)
	  {
	    char ch = tokenBuffer[i];
	    if (ch == TOKEN_ESCAPE_CHAR)
	      i++;
	    else if (Character.isLowerCase(ch))
	      lowerCount++;
	    else if (Character.isUpperCase(ch))
	      upperCount++;
	  }
	if (lowerCount == 0)