summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--GNUmakefile4
-rw-r--r--MLKDispatchingMacroCharacterReader.h38
-rw-r--r--MLKDispatchingMacroCharacterReader.m86
-rw-r--r--MLKDynamicContext.m12
-rw-r--r--MLKPackage.m4
-rw-r--r--MLKParenReader.m6
-rw-r--r--MLKReader.h19
-rw-r--r--MLKReader.m28
-rw-r--r--MLKReadtable.h10
-rw-r--r--MLKReadtable.m4
-rw-r--r--MLKSharpsignColonReader.h27
-rw-r--r--MLKSharpsignColonReader.m43
-rw-r--r--init.lisp4
-rw-r--r--util.h7
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
diff --git a/init.lisp b/init.lisp
index 7799a5f..36d0b3e 100644
--- a/init.lisp
+++ b/init.lisp
@@ -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)
diff --git a/util.h b/util.h
index 092b586..0a93aaf 100644
--- a/util.h
+++ b/util.h
@@ -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 \
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 04:42:34 +0000