diff options
| -rw-r--r-- | GNUmakefile | 4 | ||||
| -rw-r--r-- | MLKDispatchingMacroCharacterReader.h | 38 | ||||
| -rw-r--r-- | MLKDispatchingMacroCharacterReader.m | 86 | ||||
| -rw-r--r-- | MLKDynamicContext.m | 12 | ||||
| -rw-r--r-- | MLKPackage.m | 4 | ||||
| -rw-r--r-- | MLKParenReader.m | 6 | ||||
| -rw-r--r-- | MLKReader.h | 19 | ||||
| -rw-r--r-- | MLKReader.m | 28 | ||||
| -rw-r--r-- | MLKReadtable.h | 10 | ||||
| -rw-r--r-- | MLKReadtable.m | 4 | ||||
| -rw-r--r-- | MLKSharpsignColonReader.h | 27 | ||||
| -rw-r--r-- | MLKSharpsignColonReader.m | 43 | ||||
| -rw-r--r-- | init.lisp | 4 | ||||
| -rw-r--r-- | util.h | 7 |
14 files changed, 257 insertions, 35 deletions
diff --git a/GNUmakefile b/GNUmakefile index 13a7c6c..6e1f2d0 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -29,6 +29,7 @@ ADDITIONAL_OBJCFLAGS = -Wall ToiletKit_OBJC_FILES = MLKBackquoteReader.m MLKBinding.m MLKCharacter.m \ MLKCommaReader.m MLKCons.m MLKDoubleFloat.m \ + MLKDispatchingMacroCharacterReader.m \ MLKDynamicContext.m MLKEnvironment.m MLKFloat.m \ MLKInteger.m MLKInterpretedClosure.m \ MLKInterpreter.m MLKLinkedList.m \ @@ -36,7 +37,8 @@ ToiletKit_OBJC_FILES = MLKBackquoteReader.m MLKBinding.m MLKCharacter.m \ MLKLispValue.m MLKNumber.m MLKPackage.m \ MLKParenReader.m MLKQuoteReader.m MLKRatio.m \ MLKReader.m MLKReadtable.m MLKReaderError.m \ - MLKRoot.m MLKSemicolonReader.m MLKSingleFloat.m \ + MLKRoot.m MLKSemicolonReader.m \ + MLKSharpsignColonReader.m MLKSingleFloat.m \ MLKStream.m MLKStringInputStream.m \ MLKStringOutputStream.m MLKStringReader.m \ MLKSymbol.m MLKThrowException.m \ diff --git a/MLKDispatchingMacroCharacterReader.h b/MLKDispatchingMacroCharacterReader.h new file mode 100644 index 0000000..cc896e0 --- /dev/null +++ b/MLKDispatchingMacroCharacterReader.h @@ -0,0 +1,38 @@ +/* -*- 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 <http://www.gnu.org/licenses/>. + */ + +#import "MLKFuncallable.h" +#import "MLKLispValue.h" +#import "MLKCharacter.h" + +#import <Foundation/NSArray.h> +#import <Foundation/NSDictionary.h> + + +@interface MLKDispatchingMacroCharacterReader : MLKLispValue <MLKFuncallable> +{ + NSMutableDictionary *_readerMacros; +} + +-(id) init; + +-(id <MLKFuncallable>) macroFunctionForCharacter:(unichar)ch; +-(void) setMacroFunction:(id <MLKFuncallable>)function forCharacter:(unichar)ch; + +-(NSArray *) applyToArray:(NSArray *)arguments; +@end diff --git a/MLKDispatchingMacroCharacterReader.m b/MLKDispatchingMacroCharacterReader.m new file mode 100644 index 0000000..f63df16 --- /dev/null +++ b/MLKDispatchingMacroCharacterReader.m @@ -0,0 +1,86 @@ +/* -*- 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 <http://www.gnu.org/licenses/>. + */ + +#import "MLKDispatchingMacroCharacterReader.h" + +#import "MLKDynamicContext.h" +#import "MLKInteger.h" +#import "MLKReader.h" +#import "MLKReadtable.h" +#import "MLKPackage.h" +#import "MLKStream.h" +#import "runtime-compatibility.h" +#import "util.h" + + +@implementation MLKDispatchingMacroCharacterReader +-(id) init +{ + self = [super init]; + ASSIGN (_readerMacros, [NSMutableDictionary dictionary]); + return self; +} + +-(id <MLKFuncallable>) macroFunctionForCharacter:(unichar)ch +{ + return [_readerMacros objectForKey:[NSNumber numberWithLong:ch]]; +} + +-(void) setMacroFunction:(id <MLKFuncallable>)function forCharacter:(unichar)ch +{ + [_readerMacros setObject:function + forKey:[NSNumber numberWithLong:ch]]; +} + +-(NSArray *) applyToArray:(NSArray *)arguments +{ + MLKStream *stream; + MLKReadtable *readtable; + MLKPackage *cl; + unichar ch; + id <MLKFuncallable> function; + NSMutableString *prefix; + + cl = [MLKPackage findPackage:@"COMMON-LISP"]; + + stream = [arguments objectAtIndex:0]; + readtable = [[MLKDynamicContext currentContext] + valueForSymbol:[cl intern:@"*READTABLE*"]]; + + prefix = [NSMutableString string]; + while ([readtable isDecimalDigit:(ch = [stream readChar])]) + [prefix appendFormat:@"%C", ch]; + + function = [self macroFunctionForCharacter:ch]; + + if (!function) + [NSException raise:@"MLKSyntaxError" + format:@"There is no such dispatch macro subcharacter as %C.", ch]; + + return [function applyToArray: + [NSArray arrayWithObjects: + nullify(stream), + [MLKCharacter characterWithUnichar:ch], + ([prefix length] > 0 + ? (id)[MLKInteger integerWithString:prefix + negative:NO + base:10] + : (id)[NSNull null]), + nil]]; +} +@end diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m index 1b8725b..bf70929 100644 --- a/MLKDynamicContext.m +++ b/MLKDynamicContext.m @@ -27,6 +27,7 @@ #import "MLKBackquoteReader.h" #import "MLKCommaReader.h" #import "MLKCons.h" +#import "MLKDispatchingMacroCharacterReader.h" #import "MLKDynamicContext.h" #import "MLKEnvironment.h" #import "MLKLinkedList.h" @@ -36,6 +37,7 @@ #import "MLKReadtable.h" #import "MLKStringReader.h" #import "MLKSemicolonReader.h" +#import "MLKSharpsignColonReader.h" #import "MLKSymbol.h" #import "MLKInteger.h" #import "runtime-compatibility.h" @@ -61,6 +63,7 @@ static MLKDynamicContext *global_context; MLKPackage *keyword = [MLKPackage findPackage:@"KEYWORD"]; MLKSymbol *t = [cl intern:@"T"]; MLKReadtable *readtable = [[MLKReadtable alloc] init]; + MLKDispatchingMacroCharacterReader *sharpsign; unichar ch; id NIL = [NSNull null]; @@ -148,7 +151,14 @@ static MLKDynamicContext *global_context; [readtable setSyntaxType:MULTI_ESCAPE forCharacter:'|']; - // [readtable setSyntaxType:NONTERMINATING_MACRO forCharacter:'#']; + [readtable setSyntaxType:NONTERMINATING_MACRO forCharacter:'#']; + sharpsign = AUTORELEASE ([[MLKDispatchingMacroCharacterReader + alloc] init]); + [readtable setMacroFunction:sharpsign forCharacter:'#']; + + [sharpsign setMacroFunction:AUTORELEASE([[MLKSharpsignColonReader alloc] + init]) + forCharacter:':']; [readtable setSyntaxType:SINGLE_ESCAPE forCharacter:'\\']; diff --git a/MLKPackage.m b/MLKPackage.m index 94bff0a..2757455 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -90,6 +90,7 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"%DEFMACRO"]]; [sys export:[sys intern:@"%LAMBDA"]]; [sys export:[sys intern:@"%FSET"]]; + [sys export:[sys intern:@"%LOOP"]]; [sys export:[sys intern:@"CAR"]]; [sys export:[sys intern:@"CDR"]]; @@ -119,11 +120,12 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"MAKE-SYMBOL"]]; [sys export:[sys intern:@"IMPORT"]]; [sys export:[sys intern:@"INTERN"]]; + [sys export:[sys intern:@"SYMBOL-NAME"]]; + [sys export:[sys intern:@"OBJC-CLASS-OF"]]; [sys export:[sys intern:@"OBJC-SUBCLASSP"]]; [sys export:[sys intern:@"FIND-OBJC-CLASS"]]; [sys export:[sys intern:@"NS-LOG"]]; - [sys export:[sys intern:@"SYMBOL-NAME"]]; [sys export:[sys intern:@"PRIMITIVE-TYPE-OF"]]; [sys export:[sys intern:@"SEND-BY-NAME"]]; diff --git a/MLKParenReader.m b/MLKParenReader.m index b61a332..220bded 100644 --- a/MLKParenReader.m +++ b/MLKParenReader.m @@ -68,7 +68,8 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl eofValue:nil recursive:YES preserveWhitespace:NO - singleDotMarker:dotMarker]; + singleDotMarker:dotMarker + readingUninternedSymbol:NO]; if (item == dotMarker) { @@ -80,8 +81,7 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl eofError:YES eofValue:nil recursive:YES - preserveWhitespace:NO - singleDotMarker:nil]; + preserveWhitespace:NO]; [tail setCdr:nextItem]; if ((nextChar = slurpWhitespaceAndPeek (stream, readtable)) == ')') diff --git a/MLKReader.h b/MLKReader.h index 60954f1..c3446af 100644 --- a/MLKReader.h +++ b/MLKReader.h @@ -16,18 +16,21 @@ * along with this program. If not, see <http://www.gnu.org/licenses/>. */ -#include <Foundation/NSObject.h> +#include "MLKReadtable.h" +#include "MLKStream.h" -@class MLKStream, MLKReadtable; +#include <Foundation/NSObject.h> +#include <Foundation/NSString.h> @interface MLKReader : NSObject -+(id) readFromStream:(MLKStream *)stream - eofError:(BOOL)eofError - eofValue:(id)eofValue - recursive:(BOOL)recursive - preserveWhitespace:(BOOL)preserveWhitespace - singleDotMarker:(id)dotMarker; ++(id) readFromStream:(MLKStream *)stream + eofError:(BOOL)eofError + eofValue:(id)eofValue + recursive:(BOOL)recursive + preserveWhitespace:(BOOL)preserveWhitespace + singleDotMarker:(id)dotMarker +readingUninternedSymbol:(BOOL)readingUninternedSymbol; +(id) readFromStream:(MLKStream *)stream eofError:(BOOL)eofError diff --git a/MLKReader.m b/MLKReader.m index 7db9670..a6f11c1 100644 --- a/MLKReader.m +++ b/MLKReader.m @@ -50,15 +50,17 @@ eofValue:eofValue recursive:recursive preserveWhitespace:preserveWhitespace - singleDotMarker:nil]; + singleDotMarker:nil + readingUninternedSymbol:NO]; } -+(id) readFromStream:(MLKStream *)stream - eofError:(BOOL)eofError - eofValue:(id)eofValue - recursive:(BOOL)recursive - preserveWhitespace:(BOOL)preserveWhitespace - singleDotMarker:(id)dotMarker ++(id) readFromStream:(MLKStream *)stream + eofError:(BOOL)eofError + eofValue:(id)eofValue + recursive:(BOOL)recursive + preserveWhitespace:(BOOL)preserveWhitespace + singleDotMarker:(id)dotMarker +readingUninternedSymbol:(BOOL)readingUninternedSymbol { unichar ch; NSMutableString *token; @@ -72,6 +74,13 @@ valueForSymbol:[[MLKPackage findPackage:@"COMMON-LISP"] intern:@"*READTABLE*"]]; + if (readingUninternedSymbol) + { + token = [NSMutableString stringWithString:@"#:"]; + escaped = NO; + goto read_token; + } + start: if ([stream isEOF]) { @@ -89,7 +98,7 @@ if ([readtable isMacroCharacter:ch]) { NSArray *returnValues; - MLKFuncallable *macrofun = [readtable macroFunctionForCharacter:ch]; + id <MLKFuncallable> macrofun = [readtable macroFunctionForCharacter:ch]; NSArray *args = [NSArray arrayWithObjects: stream, [MLKCharacter characterWithUnichar:ch], @@ -135,6 +144,7 @@ [token appendFormat:@"%C", [readtable charWithReadtableCase:ch]]; } + read_token: while (![stream isEOF]) { //NSLog (@"..."); @@ -260,7 +270,7 @@ escaped:(BOOL)escaped { int base; - + base = [[[MLKDynamicContext currentContext] valueForSymbol:[[MLKPackage findPackage:@"COMMON-LISP"] intern:@"*READ-BASE*"]] diff --git a/MLKReadtable.h b/MLKReadtable.h index 8084890..6fb81d8 100644 --- a/MLKReadtable.h +++ b/MLKReadtable.h @@ -17,12 +17,12 @@ */ #import "MLKLispValue.h" +#import "MLKFuncallable.h" +#import <Foundation/NSDictionary.h> #import <Foundation/NSObject.h> #import <Foundation/NSString.h> -@class MLKFuncallable, NSMutableDictionary; - enum MLKReadtableCase { @@ -64,7 +64,7 @@ enum MLKConstituentTrait NSMutableDictionary *_syntaxTable; NSMutableDictionary *_readerMacros; NSMutableDictionary *_traits; - //MLKFuncallable *_caseConverter; + //id <MLKFuncallable> _caseConverter; enum MLKReadtableCase _case; } @@ -100,8 +100,8 @@ enum MLKConstituentTrait -(BOOL) isDigit:(unichar)ch inBase:(int)base; -(int) digitWeight:(unichar)ch; --(MLKFuncallable *) macroFunctionForCharacter:(unichar)ch; --(void) setMacroFunction:(MLKFuncallable *)function forCharacter:(unichar)ch; +-(id <MLKFuncallable>) macroFunctionForCharacter:(unichar)ch; +-(void) setMacroFunction:(id <MLKFuncallable>)function forCharacter:(unichar)ch; -(unichar) charWithReadtableCase:(unichar)ch; -(int) characterConstituentTraits:(unichar)ch; diff --git a/MLKReadtable.m b/MLKReadtable.m index 01e6b38..95180e5 100644 --- a/MLKReadtable.m +++ b/MLKReadtable.m @@ -92,12 +92,12 @@ DEFINE_SYNTAX_PREDICATE(isConstituentCharacter:, CONSTITUENT) isEqual:[[NSString stringWithFormat:@"%C", ch] lowercaseString]]); } --(MLKFuncallable *) macroFunctionForCharacter:(unichar)ch; +-(id <MLKFuncallable>) macroFunctionForCharacter:(unichar)ch; { return [_readerMacros objectForKey:[NSNumber numberWithLong:ch]]; } --(void) setMacroFunction:(MLKFuncallable *)function forCharacter:(unichar)ch +-(void) setMacroFunction:(id <MLKFuncallable>)function forCharacter:(unichar)ch { [_readerMacros setObject:function forKey:[NSNumber numberWithLong:ch]]; diff --git a/MLKSharpsignColonReader.h b/MLKSharpsignColonReader.h new file mode 100644 index 0000000..1f72275 --- /dev/null +++ b/MLKSharpsignColonReader.h @@ -0,0 +1,27 @@ +/* -*- 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 <http://www.gnu.org/licenses/>. + */ + +#import "MLKFuncallable.h" +#import "MLKLispValue.h" + +#import <Foundation/NSArray.h> + + +@interface MLKSharpsignColonReader : MLKLispValue <MLKFuncallable> +-(NSArray *) applyToArray:(NSArray *)arguments; +@end diff --git a/MLKSharpsignColonReader.m b/MLKSharpsignColonReader.m new file mode 100644 index 0000000..5e4990e --- /dev/null +++ b/MLKSharpsignColonReader.m @@ -0,0 +1,43 @@ +/* -*- 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 <http://www.gnu.org/licenses/>. + */ + +#import "MLKSharpsignColonReader.h" + +#import "MLKReader.h" +#import "MLKStream.h" +#import "runtime-compatibility.h" +#import "util.h" + + +@implementation MLKSharpsignColonReader +-(NSArray *) applyToArray:(NSArray *)arguments +{ + MLKStream *stream; + + stream = [arguments objectAtIndex:0]; + + return [NSArray arrayWithObject: + nullify([MLKReader readFromStream:stream + eofError:YES + eofValue:nil + recursive:YES + preserveWhitespace:NO + singleDotMarker:nil + readingUninternedSymbol:YES])]; +} +@end @@ -18,7 +18,6 @@ (in-package #:common-lisp) -(in-package :common-lisp) (load "util.lisp") (load "defun-0.lisp") (load "list-functions.lisp") @@ -28,4 +27,5 @@ (load "control-flow.lisp") (load "types.lisp") (load "list-functions-2.lisp") -(in-package :common-lisp-user) + +(in-package #:common-lisp-user) @@ -1,6 +1,7 @@ -#include "runtime-compatibility.h" -#include <Foundation/NSException.h> -#include <Foundation/NSNull.h> +#import "runtime-compatibility.h" +#import <Foundation/NSException.h> +#import <Foundation/NSNull.h> +#import "MLKSymbol.h" #define DEFINE_GMP_OPERATION(SIGNATURE, TYPE, GMPOP, RETTYPE, OBJTYPE, CONSTRUCTOR) \ -(RETTYPE *) SIGNATURE \ |