From 0aa846ba78d2041d688a25835fb6143e1bf92e2a Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Tue, 18 Dec 2007 23:07:57 -0500
Subject: [PATCH] reduced size of parser, and added two helpers for reading and
 recording position.

---
 scheme/ikarus.reader.ss | 92 ++++++++++++++++++++++++++++++-----------
 scheme/last-revision    |  2 +-
 2 files changed, 68 insertions(+), 26 deletions(-)

diff --git a/scheme/ikarus.reader.ss b/scheme/ikarus.reader.ss
index 1d31188..eebc916 100644
--- a/scheme/ikarus.reader.ss
+++ b/scheme/ikarus.reader.ss
@@ -994,6 +994,33 @@
           [(char-whitespace? c) (tokenize/1 p)]
           [else (tokenize/c c p)]))))
 
+  (define tokenize/1+pos
+    (lambda (p)
+      (let ([pos (input-port-byte-position p)])
+        (let ([c (read-char p)])
+          (cond
+            [(eof-object? c) (values pos (eof-object))]
+            [(eqv? c #\;)
+             (skip-comment p)
+             (tokenize/1+pos p)]
+            [(eqv? c #\#)
+             (let ([pos (input-port-byte-position p)])
+               (let ([c (read-char p)])
+                 (cond
+                   [(eof-object? c) 
+                    (die/p p 'tokenize "invalid eof after #")]
+                   [(eqv? c #\;)
+                    (my-read p)   ; skip s-expr
+                    (tokenize/1+pos p)]
+                   [(eqv? c #\|) 
+                    (multiline-comment p)
+                    (tokenize/1+pos p)]
+                   [else
+                    (values (tokenize-hash/c c p) pos)])))]
+            [(char-whitespace? c) (tokenize/1+pos p)]
+            [else 
+             (values (tokenize/c c p) pos)])))))
+
   (define tokenize-script-initial
     (lambda (p)
       (let ([c (read-char p)])
@@ -1021,18 +1048,49 @@
           [(char-whitespace? c) (tokenize/1 p)]
           [else (tokenize/c c p)]))))
 
+  (define tokenize-script-initial+pos
+    (lambda (p)
+      (let ([pos (input-port-byte-position p)])
+        (let ([c (read-char p)])
+          (cond
+            [(eof-object? c) (values (eof-object) p)]
+            [(eqv? c #\;)
+             (skip-comment p)
+             (tokenize/1+pos p)]
+            [(eqv? c #\#) 
+             (let ([pos (input-port-byte-position p)])
+               (let ([c (read-char p)])
+                 (cond
+                   [(eof-object? c)
+                    (die/p p 'tokenize "invalid eof after #")]
+                   [(eqv? c #\!)
+                    (skip-comment p)
+                    (tokenize/1+pos p)]
+                   [(eqv? c #\;)
+                    (my-read p)   ; skip s-expr
+                    (tokenize/1+pos p)]
+                   [(eqv? c #\|) 
+                    (multiline-comment p)
+                    (tokenize/1+pos p)]
+                   [else
+                    (values (tokenize-hash/c c p) pos)])))]
+            [(char-whitespace? c) (tokenize/1+pos p)]
+            [else (values (tokenize/c c p) pos)])))))
+
   (define-struct loc (value set?))
   (module (read-expr read-expr-script-initial)
-    (define read-list-rest
-      (lambda (p locs k end mis)
+    (define read-list
+      (lambda (p locs k end mis init?)
         (let ([t (tokenize/1 p)])
           (cond
            [(eof-object? t)
             (die/p p 'read "end of file encountered while reading list")]
            [(eq? t end) (values '() locs k)]
-           [(eq? t mis) 
+           [(eq? t mis)
             (die/p-1 p 'read "paren mismatch")]
            [(eq? t 'dot)
+            (when init?
+              (die/p-1 p 'read "invalid dot while reading list"))
             (let-values ([(d locs k) (read-expr p locs k)])
               (let ([t (tokenize/1 p)])
                 (cond
@@ -1046,31 +1104,12 @@
                     (format "expecting ~a, got ~a" end t))])))]
            [else
             (let-values ([(a locs k) (parse-token p locs k t)])
-              (let-values ([(d locs k) (read-list-rest p locs k end mis)])
+              (let-values ([(d locs k) (read-list p locs k end mis #f)])
                  (let ([x (cons a d)])
                    (values x locs 
                            (if (or (loc? a) (loc? d))
                                (extend-k-pair x k)
                                k)))))]))))
-    (define read-list-init
-      (lambda (p locs k end mis)
-        (let ([t (tokenize/1 p)])
-         (cond
-           [(eof-object? t)
-            (die/p p 'read "end of file encountered while reading list")]
-           [(eq? t end) (values '() locs k)]
-           [(eq? t mis) 
-            (die/p-1 p 'read "paren mismatch")]
-           [(eq? t 'dot)
-            (die/p-1 p 'read "invalid dot while reading list")]
-           [else
-            (let-values ([(a locs k) (parse-token p locs k t)])
-              (let-values ([(d locs k) (read-list-rest p locs k end mis)])
-                (let ([x (cons a d)])
-                   (values x locs 
-                      (if (or (loc? a) (loc? d))
-                          (extend-k-pair x k)
-                          k)))))]))))
     (define extend-k-pair
       (lambda (x k)
         (lambda ()
@@ -1147,8 +1186,8 @@
       (lambda (p locs k t)
         (cond
           [(eof-object? t) (values (eof-object) locs k)]
-          [(eq? t 'lparen) (read-list-init p locs k 'rparen 'rbrack)]
-          [(eq? t 'lbrack) (read-list-init p locs k 'rbrack 'rparen)]
+          [(eq? t 'lparen) (read-list p locs k 'rparen 'rbrack #t)]
+          [(eq? t 'lbrack) (read-list p locs k 'rbrack 'rparen #t)]
           [(eq? t 'vparen) (read-vector p locs k 0 '())]
           [(eq? t 'vu8) (read-bytevector p locs k 0 '())]
           [(pair? t)
@@ -1212,6 +1251,9 @@
   ;;; - expression is a list/vector/id/whathaveyou that 
   ;;;   may contain further annotations.
 
+
+
+
   (define reduce-loc!
     (lambda (x)
        (let ([loc (cdr x)])
diff --git a/scheme/last-revision b/scheme/last-revision
index c2306a4..5c59e57 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1263
+1264