/* -*- 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
#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])
{
// ???
}
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]];
symbolName = [token substringFromIndex:(packageMarker+1)];
}
symbol = [package intern:token];
if (packageMarker == 0)
{
// Make keyword symbols self-evaluate.
[[MLKDynamicContext currentContext] setValue:symbol forBinding:symbol];
}
return symbol;
}
}
@end