/* -*- 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 "MLKFuncallable.h"
#import "MLKStream.h"
#import "MLKFloat.h"
#import "MLKInteger.h"
#import "MLKRatio.h"
#import "MLKStringInputStream.h"
#import "runtime-compatibility.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;
BOOL ever_escaped;
ever_escaped = NO;
readtable = [[MLKDynamicContext currentContext]
valueForSymbol:[[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] || ch == '\0')
goto start;
if ([readtable isMacroCharacter:ch])
{
NSArray *returnValues;
MLKFuncallable *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] == [NSNull null]
? nil
: [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]];
ever_escaped = YES;
}
if ([readtable isMultipleEscapeCharacter:ch])
{
token = [NSMutableString stringWithCapacity:8];
escaped = YES;
ever_escaped = YES;
}
if ([readtable isConstituentCharacter:ch])
{
//NSLog (@"--> Constituent (%C)", ch);
token = [NSMutableString stringWithCapacity:8];
[token appendFormat:@"%C", [readtable charWithReadtableCase:ch]];
}
while (![stream isEOF])
{
//NSLog (@"...");
ch = [stream readChar];
if ([readtable isConstituentCharacter:ch] ||
[readtable isNonTerminatingMacroCharacter:ch] ||
(escaped && (![readtable isMultipleEscapeCharacter:ch]
&& ![readtable isSingleEscapeCharacter: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 appendFormat:@"%C", [stream readChar]];
ever_escaped = YES;
}
else if ([readtable isMultipleEscapeCharacter:ch])
{
ever_escaped = YES;
escaped = !escaped;
}
else if ([readtable isTerminatingMacroCharacter:ch])
{
[stream unreadChar:ch];
break;
}
else if ([readtable isConstituentCharacter:ch]
&& [readtable isInvalid:ch])
{
//[[[MLKReaderError alloc] initWithStream:stream] raise];
[NSException raise:@"MLKReaderError"
format:@"'%c' is an invalid constituent character.", ch];
}
else if ([readtable isWhitespaceCharacter:ch])
{
if (preserveWhitespace)
[stream unreadChar:ch];
break;
}
}
//NSLog (@"--> Interpret token: %@", token);
return [self interpretToken:token
readtable:readtable
escaped:ever_escaped];
}
+(BOOL) isPotentialNumber:(NSString *)token
readtable:(MLKReadtable *)readtable
base:(int)base
{
// 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 inBase:base]
|| [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 inBase:base])
goto digitFound;
}
return NO;
digitFound:
// 3. Is the first character okay?
first = [token characterAtIndex:0];
if (!([readtable isDigit:first inBase:base]
|| [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
escaped:(BOOL)escaped
{
int base;
base = [[[MLKDynamicContext currentContext]
valueForSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
intern:@"*READ-BASE*"]]
intValue];
if (!escaped && [self isPotentialNumber:token readtable:readtable base:base])
{
unsigned long i, firstNum, secondNum, exponent, exponentMarkerPos;
unichar sign, exponentSign;
unichar firstSeparator, exponentMarker;
BOOL negative;
// 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 && [readtable isMinusSign:sign]);
while ((i < [token length])
&& [readtable isDecimalDigit:[token characterAtIndex:i]])
i++;
if (i == [token length])
{
//NSLog (@"...");
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])
{
//NSLog (@"+++");
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++;
//NSLog (@"...2");
//NSLog (@"%@, %@",
// [token substringWithRange:NSMakeRange (firstNum, exponentMarkerPos - firstNum - 1)],
// [token substringFromIndex:exponent]);
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])
{
//NSLog (@"...3");
//NSLog (@"%@, %@",
// [token substringWithRange:NSMakeRange (firstNum, secondNum - firstNum - 1)],
// [token substringFromIndex:secondNum]);
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++;
//NSLog (@"...4");
//NSLog (@"%@, %@, %@",
// [token substringWithRange:NSMakeRange (firstNum, secondNum - firstNum - 1)],
// [token substringWithRange:NSMakeRange (secondNum, exponentMarkerPos - secondNum)],
// [token substringFromIndex:exponent]);
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:i] inBase:base])
i++;
if (i == [token length])
{
//NSLog (@"###");
return [MLKInteger integerWithString:
[token substringWithRange:
NSMakeRange (firstNum, [token length] - firstNum)]
negative:negative
base:base];
}
// Assume token[i] is a slash.
i++;
secondNum = i;
//NSLog (@"RRR");
//NSLog (@"n: %@", [token substringWithRange:
// NSMakeRange (firstNum,
// secondNum - firstNum - 1)]);
//NSLog (@"d: %@", [token substringFromIndex:secondNum]);
return [MLKRatio ratioWithNumeratorString:
[token substringWithRange:
NSMakeRange (firstNum,
secondNum - firstNum - 1)]
denominatorString:[token substringFromIndex:secondNum]
negative:negative
base:base];
}
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]
valueForSymbol:[[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 (!package)
[NSException raise:@"MLKReaderError"
format:@"Can't find package %@.",
[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)];
symbol = [package intern:symbolName];
if (![[package exportedSymbols] containsObject:symbol])
[NSException raise:@"MLKReaderError"
format:@"Package %@ does not export symbol %@.",
[package name], [symbol descriptionForLisp]];
}
}
symbol = [package intern:symbolName];
if (packageMarker == 0)
{
// Make keyword symbols self-evaluate.
[[MLKDynamicContext globalContext] addValue:symbol forSymbol:symbol];
}
return symbol;
}
}
+(id) readFromString:(NSString *)string
{
return [self readFromStream:[[MLKStringInputStream alloc]
initWithString:string]
eofError:YES
eofValue:nil
recursive:NO
preserveWhitespace:NO];
}
@end