From ca1c83c21c967593dfa4fced6084e83361bc6cf3 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sat, 26 Jul 2008 11:48:01 +0200
Subject: Reader: Support the consing dot.

---
 MLKParenReader.m | 34 ++++++++++++++++++++++++++++++++--
 MLKReader.h      |  7 +++++++
 MLKReader.m      | 25 +++++++++++++++++++++++++
 3 files changed, 64 insertions(+), 2 deletions(-)

diff --git a/MLKParenReader.m b/MLKParenReader.m
index 9287ce9..b61a332 100644
--- a/MLKParenReader.m
+++ b/MLKParenReader.m
@@ -59,6 +59,7 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
   while ((nextChar = slurpWhitespaceAndPeek(stream, readtable)) != ')')
     {
       id item;
+      id dotMarker = [[NSObject alloc] init];
 
       // FIXME: What to do about dots?  Maybe add a new
       // singleDotAllowed:(BOOL)dotp argument to readFromStream:...?
@@ -66,8 +67,35 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
                         eofError:YES
                         eofValue:nil
                         recursive:YES
-                        preserveWhitespace:NO];
-      
+                        preserveWhitespace:NO
+                        singleDotMarker:dotMarker];
+
+      if (item == dotMarker)
+        {
+          id nextItem;
+
+          RELEASE (dotMarker);
+
+          nextItem = [MLKReader readFromStream:stream
+                                eofError:YES
+                                eofValue:nil
+                                recursive:YES
+                                preserveWhitespace:NO
+                                singleDotMarker:nil];
+          [tail setCdr:nextItem];
+
+          if ((nextChar = slurpWhitespaceAndPeek (stream, readtable)) == ')')
+            {
+              [stream readChar];
+              return [NSArray arrayWithObject:cons];
+            }
+          else
+            {
+              [NSException raise:@"MLKReaderError"
+                           format:@"Unexpectedly read a single dot."];
+            }
+        }
+
       if (!tail)
         {
           cons = tail = [MLKCons cons:item with:nil];
@@ -77,6 +105,8 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
           [tail setCdr:[MLKCons cons:item with:nil]];
           tail = [tail cdr];
         }
+
+      RELEASE (dotMarker);
     }
 
   [stream readChar];
diff --git a/MLKReader.h b/MLKReader.h
index 9a49ef9..60954f1 100644
--- a/MLKReader.h
+++ b/MLKReader.h
@@ -22,6 +22,13 @@
 
 
 @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
diff --git a/MLKReader.m b/MLKReader.m
index 7343c64..7db9670 100644
--- a/MLKReader.m
+++ b/MLKReader.m
@@ -44,6 +44,21 @@
             eofValue:(id)eofValue
            recursive:(BOOL)recursive
   preserveWhitespace:(BOOL)preserveWhitespace
+{
+  return [self readFromStream:stream
+               eofError:eofError
+               eofValue:eofValue
+               recursive:recursive
+               preserveWhitespace:preserveWhitespace
+               singleDotMarker:nil];
+}
+
++(id) readFromStream:(MLKStream *)stream
+            eofError:(BOOL)eofError
+            eofValue:(id)eofValue
+           recursive:(BOOL)recursive
+  preserveWhitespace:(BOOL)preserveWhitespace
+     singleDotMarker:(id)dotMarker
 {
   unichar ch;
   NSMutableString *token;
@@ -169,6 +184,16 @@
     }
 
   //NSLog (@"--> Interpret token: %@", token);
+
+  if ([token isEqualToString:@"."])
+    {
+      if (dotMarker)
+        return dotMarker;
+      else
+        [NSException raise:@"MLKReaderError"
+                     format:@"Unexpectedly read a single dot."];
+    }
+
   return [self interpretToken:token
                readtable:readtable
                escaped:ever_escaped];
-- 
cgit v1.2.3