Reader: Add support for dispatching macro characters.

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                                                \