Add class MLKParenReader.

6 files changed, 127 insertions, 7 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 12b622d..a43461b 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -18,13 +18,14 @@
 include $(GNUSTEP_MAKEFILES)/common.make
 
 TOOL_NAME = etoilisp
-etoilisp_OBJC_FILES = MLKCharacter.m MLKCons.m MLKDoubleFloat.m			\
-                      MLKDynamicContext.m MLKEndOfFileError.m			\
-                      MLKEnvironment.m MLKError.m MLKFloat.m			\
-                      MLKInteger.m MLKLinkedList.m MLKLispValue.m		\
-                      MLKPackage.m MLKRatio.m MLKReader.m MLKReadtable.m	\
-                      MLKReaderError.m MLKSingleFloat.m MLKStream.m		\
-                      MLKSymbol.m MLKThrowException.m				\
+etoilisp_OBJC_FILES = MLKCharacter.m MLKCons.m MLKDoubleFloat.m		\
+                      MLKDynamicContext.m MLKEndOfFileError.m		\
+                      MLKEnvironment.m MLKError.m MLKFloat.m		\
+                      MLKInteger.m MLKLinkedList.m MLKLispValue.m	\
+                      MLKPackage.m MLKParenReader.m MLKRatio.m		\
+                      MLKReader.m MLKReadtable.m MLKReaderError.m	\
+                      MLKSingleFloat.m MLKStream.m MLKSymbol.m		\
+                      MLKThrowException.m				\
                       MLKUndefinedVariableException.m
 
 BUNDLE_NAME = Test
diff --git a/MLKCharacter.h b/MLKCharacter.h
index 04049d4..220ab18 100644
--- a/MLKCharacter.h
+++ b/MLKCharacter.h
@@ -30,6 +30,8 @@
 
 +(MLKCharacter *) characterWithUnichar:(unichar)anUnichar;
 
+-(unichar) unicharValue;
+
 -(MLKCharacter *) uppercaseCharacter;
 -(MLKCharacter *) lowercaseCharacter;
 
diff --git a/MLKCharacter.m b/MLKCharacter.m
index 5daa22c..c70fd52 100644
--- a/MLKCharacter.m
+++ b/MLKCharacter.m
@@ -32,6 +32,11 @@
   return [[MLKCharacter alloc] initWithUnichar:anUnichar];
 }
 
+-(unichar) unicharValue
+{
+  return self->unichar;
+}
+
 -(MLKCharacter *) uppercaseCharacter
 {
   return [MLKCharacter characterWithUnichar:[self uppercaseChar]];
diff --git a/MLKFuncallable.h b/MLKFuncallable.h
index 6f7fd40..d4fdb1c 100644
--- a/MLKFuncallable.h
+++ b/MLKFuncallable.h
@@ -21,4 +21,5 @@
 
 @protocol MLKFuncallable
 -(NSArray *) applyToArray:(NSArray *)arguments;
+//FIXME?  -(MLKCons) lambdaList;
 @end
diff --git a/MLKParenReader.h b/MLKParenReader.h
new file mode 100644
index 0000000..88be03e
--- /dev/null
+++ b/MLKParenReader.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"
+
+@class NSArray;
+
+
+@interface MLKParenReader : MLKLispValue <MLKFuncallable>
+-(NSArray *) applyToArray:(NSArray *)arguments;
+@end
diff --git a/MLKParenReader.m b/MLKParenReader.m
new file mode 100644
index 0000000..f50cf68
--- /dev/null
+++ b/MLKParenReader.m
@@ -0,0 +1,84 @@
+/* -*- 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 "MLKParenReader.h"
+
+#import "MLKCharacter.h"
+#import "MLKCons.h"
+#import "MLKDynamicContext.h"
+#import "MLKReader.h"
+#import "MLKReadtable.h"
+#import "MLKPackage.h"
+#import "MLKStream.h"
+
+#import <Foundation/NSArray.h>
+
+
+static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtable)
+{
+  unichar ch;
+  while ([readtable isWhitespaceCharacter:(ch = [stream readChar])]);
+  [stream unreadChar:ch];
+  return ch;
+}
+
+
+@implementation MLKParenReader
+-(NSArray *) applyToArray:(NSArray *)arguments
+{
+  MLKStream *stream;
+  unichar ch;
+  MLKReadtable *readtable;
+  MLKCons *cons, *tail;
+  unichar nextChar;
+  
+  stream = [arguments objectAtIndex:0];
+  ch = [[arguments objectAtIndex:1] unicharValue];
+  readtable = [[MLKDynamicContext currentContext]
+                valueForBinding:[[MLKPackage findPackage:@"COMMON-LISP"]
+                                  intern:@"*READTABLE*"]];
+  cons = nil;
+  tail = nil;
+
+  nextChar = slurpWhitespaceAndPeek(stream, readtable);
+  while (nextChar != ')')
+    {
+      id item;
+
+      // FIXME: What to do about dots?  Maybe add a new
+      // singleDotAllowed:(BOOL)dotp argument to readFromStream:...?
+      item = [MLKReader readFromStream:stream
+                        eofError:YES
+                        eofValue:nil
+                        recursive:YES
+                        preserveWhitespace:NO];
+      
+      if (!tail)
+        {
+          cons = tail = [MLKCons cons:item with:nil];
+        }
+      else
+        {
+          [tail setCdr:[MLKCons cons:item with:nil]];
+          tail = [tail cdr];
+        }
+    }
+
+  return [NSArray arrayWithObject:cons];
+}
+@end