/* -*- mode: objc; coding: utf-8 -*- */
/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
* Copyright (C) 2008 Matthias Andreas Benkard.
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or (at
* your option) any later version.
*
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#import "MLKReader.h"
#import "MLKCharacter.h"
#import "MLKReadtable.h"
#import "MLKEndOfFileError.h"
#import "MLKReaderError.h"
#import "MLKDynamicContext.h"
#import "MLKEnvironment.h"
#import "MLKPackage.h"
#import "MLKClosure.h"
#import "MLKStream.h"
#import "MLKFloat.h"
#import "MLKInteger.h"
#import "MLKRatio.h"
#import
#import
#import
#import
@implementation MLKReader
+(id) readFromStream:(MLKStream *)stream
eofError:(BOOL)eofError
eofValue:(id)eofValue
recursive:(BOOL)recursive
preserveWhitespace:(BOOL)preserveWhitespace
{
unichar ch;
NSMutableString *token;
MLKReadtable *readtable;
BOOL escaped;
readtable = [[MLKDynamicContext currentContext]
valueForBinding:[[MLKPackage findPackage:@"COMMON-LISP"]
intern:@"*READTABLE*"]];
start:
if ([stream isEOF])
{
if (eofError)
[[[MLKEndOfFileError alloc] initWithStream:stream] raise];
else
return eofValue;
}
ch = [stream readChar];
if ([readtable isWhitespaceCharacter:ch])
goto start;
if ([readtable isMacroCharacter:ch])
{
NSArray *returnValues;
MLKClosure *macrofun = [readtable macroFunctionForCharacter:ch];
NSArray *args = [NSArray arrayWithObjects:
stream,
[MLKCharacter characterWithUnichar:ch],
nil];
if ([args count] != 2)
{
args = [NSMutableArray arrayWithCapacity:2];
[((NSMutableArray*)args) addObject:stream];
[((NSMutableArray*)args) addObject:[MLKCharacter
characterWithUnichar:ch]];
}
returnValues = [macrofun applyToArray:args];
if ([returnValues count])
return [returnValues objectAtIndex:0];
else
goto start;
}
escaped = NO;
if ([readtable isSingleEscapeCharacter:ch])
{
if ([stream isEOF])
[[[MLKEndOfFileError alloc] initWithStream:stream] raise];
token = [NSMutableString stringWithCapacity:8];
[token appendFormat:@"%C", [stream readChar]];
}
if ([readtable isMultipleEscapeCharacter:ch])
{
token = [NSMutableString stringWithCapacity:8];
escaped = YES;
}
if ([readtable isConstituentCharacter:ch])
{
token = [NSMutableString stringWithCapacity:8];
[token appendFormat:@"%C", [stream readChar]];
}
while (![stream isEOF])
{
ch = [stream readChar];
if ([readtable isConstituentCharacter:ch] ||
[readtable isNonTerminatingMacroCharacter:ch] ||
(escaped && [readtable isWhitespaceCharacter:ch]))
{
if (escaped)
[token appendFormat:@"%C", ch];
else
[token appendFormat:@"%C", [readtable charWithReadtableCase:ch]];
}
else if ([readtable isSingleEscapeCharacter:ch])
{
if ([stream isEOF])
[[[MLKEndOfFileError alloc] initWithStream:stream] raise];
token = [NSMutableString stringWithCapacity:8];
[token appendFormat:@"%C", [stream readChar]];
}
else if ([readtable isMultipleEscapeCharacter:ch])
escaped = !escaped;
else if ([readtable isTerminatingMacroCharacter:ch])
{
[stream unreadChar:ch];
break;
}
else if ([readtable isInvalid:ch])
{
[[[MLKReaderError alloc] initWithStream:stream] raise];
}
else if ([readtable isWhitespaceCharacter:ch])
{
if (preserveWhitespace)
[stream unreadChar:ch];
break;
}
}
return [self interpretToken:token readtable:readtable];
}
+(BOOL) isPotentialNumber:(NSString *)token readtable:(MLKReadtable *)readtable
{
// Check whether the token is a potential number.
//
// See CLHS 2.3.1.1.
unsigned long i;
unichar first;
// 1. Does it consist solely of characters allowed in a potential
// number?
for (i = 0; i < [token length]; i++)
{
unichar ch = [token characterAtIndex:i];
if (!([readtable isDigit:ch]
|| [readtable isSign:ch]
|| [readtable isRatioMarker:ch]
|| [readtable isDecimalPoint:ch]
|| ch == '^'
|| ch == '_'
|| ([readtable isNumberMarker:ch]
// Adjacent number markers aren't to be considered number
// markers at all.
&& (i == 0
|| ![readtable
isNumberMarker:[token characterAtIndex:(i-1)]]))))
return NO;
}
// 2. Does the token contain a digit?
for (i = 0; i < [token length]; i++)
{
unichar ch = [token characterAtIndex:i];
if ([readtable isDigit:ch])
goto digitFound;
}
return NO;
digitFound:
// 3. Is the first character okay?
first = [token characterAtIndex:0];
if (!([readtable isDigit:first]
|| [readtable isSign:first]
|| [readtable isDecimalPoint:first]
|| first == '^'
|| first == '_'))
return NO;
// 4. Does the token not end with a sign?
if ([readtable isSign:[token characterAtIndex:([token length]-1)]])
return NO;
return YES;
}
+(id) interpretToken:(NSString *)token readtable:(MLKReadtable *)readtable
{
if ([self isPotentialNumber:token readtable:readtable])
{
unsigned long i, firstNum, secondNum, exponent, exponentMarkerPos;
unichar sign, exponentSign;
unichar firstSeparator, exponentMarker;
BOOL negative;
MLKInteger *base;
base = [[MLKDynamicContext currentContext]
valueForBinding:[[MLKPackage findPackage:@"COMMON-LISP"]
intern:@"*READ-BASE*"]];
// Read the sign (if present).
if ([readtable isSign:[token characterAtIndex:0]])
{
sign = [token characterAtIndex:0];
i = 1;
firstNum = 1;
}
else
{
i = 0;
firstNum = 0;
}
negative = (firstNum > 0 && sign == '-');
while ((i < [token length])
&& [readtable isDecimalDigit:[token characterAtIndex:i]])
i++;
if (i == [token length])
{
return [MLKInteger integerWithString:
[token substringWithRange:
NSMakeRange (firstNum, [token length] - firstNum)]
negative:negative
base:10];
}
firstSeparator = [token characterAtIndex:i];
if (!([readtable isDecimalPoint:firstSeparator]
|| [readtable isExponentMarker:[token characterAtIndex:i]]))
goto digits;
i++;
secondNum = i;
if (i == [token length] && [readtable isDecimalPoint:firstSeparator])
{
return [MLKInteger integerWithString:
[token substringWithRange:
NSMakeRange (firstNum, [token length] - firstNum - 1)]
negative:negative
base:10];
}
else
{
// We're dealing with a floating point number. Bah. I hate
// floating point numbers.
if ([readtable isExponentMarker:firstSeparator])
{
exponentMarkerPos = i;
if ([readtable isSign:[token characterAtIndex:i]])
{
exponentSign = [token characterAtIndex:i];
i++;
}
else
exponentSign = '+';
exponent = i;
while ((i < [token length])
&& [readtable isDecimalDigit:[token characterAtIndex:i]])
i++;
return [MLKFloat floatWithExponentMarker:firstSeparator
integerPart:[token substringWithRange:NSMakeRange(firstNum, exponentMarkerPos - firstNum - 1)]
negative:negative
fractionalPart:@""
exponent:[token substringFromIndex:exponent]
exponentNegative:(exponentSign == '-')];
}
else
{
while ((i < [token length])
&& [readtable isDecimalDigit:[token characterAtIndex:i]])
i++;
if (i == [token length])
{
return [MLKFloat floatWithExponentMarker:firstSeparator
integerPart:[token substringWithRange:NSMakeRange (firstNum, secondNum - firstNum - 1)]
negative:negative
fractionalPart:[token substringFromIndex:secondNum]
exponent:@""
exponentNegative:NO];
}
// Assume token[i] is an exponent marker.
exponentMarkerPos = i;
exponentMarker = [token characterAtIndex:i];
i++;
if ([readtable isSign:[token characterAtIndex:i]])
{
exponentSign = [token characterAtIndex:i];
i++;
}
else
exponentSign = '+';
exponent = i;
while ((i < [token length])
&& [readtable isDecimalDigit:[token characterAtIndex:i]])
i++;
return [MLKFloat floatWithExponentMarker:exponentMarker
integerPart:[token substringWithRange:NSMakeRange (firstNum, secondNum - firstNum - 1)]
negative:negative
fractionalPart:[token substringWithRange:NSMakeRange (secondNum, exponentMarkerPos - secondNum)]
exponent:[token substringFromIndex:exponent]
exponentNegative:(exponentSign == '-')];
}
}
digits:
i = firstNum;
while ((i < [token length])
&& [readtable isDigit:[token characterAtIndex:0]])
i++;
if (i == [token length])
{
return [MLKInteger integerWithString:
[token substringWithRange:
NSMakeRange (firstNum, [token length] - firstNum)]
negative:negative
base:[base intValue]];
}
// Assume token[i] is a slash.
i++;
secondNum = i;
return [MLKRatio ratioWithNumeratorString:
[token substringWithRange:
NSMakeRange (firstNum,
secondNum - firstNum - 1)]
denominatorString:[token substringFromIndex:secondNum]
base:[base intValue]];
}
else
{
unsigned long i, packageMarker;
MLKPackage *package;
NSString *symbolName;
MLKSymbol *symbol;
// Look for the package marker.
packageMarker = -1;
for (i = 0; i < [token length]; i++)
{
if ([readtable isPackageMarker:[token characterAtIndex:i]])
{
packageMarker = i;
break;
}
}
// Extract the package and symbol name.
if (packageMarker == -1)
{
package = [[MLKDynamicContext currentContext]
valueForBinding:[[MLKPackage
findPackage:@"COMMON-LISP"]
intern:@"*PACKAGE*"]];
symbolName = token;
}
else if (packageMarker == 0)
{
package = [MLKPackage findPackage:@"KEYWORD"];
symbolName = [token substringFromIndex:1];
}
else
{
package = [MLKPackage
findPackage:[token substringToIndex:packageMarker]];
if ([readtable isPackageMarker:[token characterAtIndex:(i+1)]])
symbolName = [token substringFromIndex:(packageMarker+2)];
else
{
// A single package marker means we have to check whether
// the symbol is external in the package.
symbolName = [token substringFromIndex:(packageMarker+1)];
if (![[package exportedSymbols] containsObject:[package intern:token]])
[[[MLKReaderError alloc] init] raise];
}
}
symbol = [package intern:symbolName];
if (packageMarker == 0)
{
// Make keyword symbols self-evaluate.
[[MLKDynamicContext currentContext] setValue:symbol forBinding:symbol];
}
return symbol;
}
}
@end