1 files changed, 86 insertions, 0 deletions
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