Make sure that line number is properly updated.
authorChris Hanson <org/chris-hanson/cph>
Sat, 30 Jun 2001 03:21:23 +0000 (03:21 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 30 Jun 2001 03:21:23 +0000 (03:21 +0000)
v7/src/star-parser/buffer.scm

index afc78ad0e5f7d7fe7655e8c991b7e0a97cd82db6..257ca1815b112ad0580f5b207c08a8519b205c5c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.5 2001/06/29 05:21:43 cph Exp $
+;;; $Id: buffer.scm,v 1.6 2001/06/30 03:21:23 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
      (number->string (+ (parser-buffer-pointer-line pointer) 1))
      ", char "
      (number->string (+ (parser-buffer-pointer-index pointer) 1)))))
+
+(define (read-parser-buffer-char buffer)
+  ;; Attempt to read the next character from BUFFER, starting at the
+  ;; current position.  If there is a character available, increment
+  ;; the position and return the character.  If there are no more
+  ;; characters available, return #F and leave the position unchanged.
+  (let ((char (peek-parser-buffer-char buffer)))
+    (if char
+       (increment-buffer-index! buffer char))
+    char))
+
+(define (peek-parser-buffer-char buffer)
+  ;; Attempt to read the next character from BUFFER, starting at the
+  ;; current position.  If there is a character available, return it,
+  ;; otherwise return #F.  The position is unaffected in either case.
+  (and (guarantee-buffer-chars buffer 1)
+       (string-ref (parser-buffer-string buffer)
+                  (parser-buffer-index buffer))))
 \f
 (let-syntax
     ((char-matcher
                    ,test)))
           (DEFINE (,(symbol-append 'MATCH-PARSER-BUFFER- name)
                    BUFFER REFERENCE)
-            (AND (LET ((CHAR (PEEK-PARSER-BUFFER-CHAR BUFFER)))
-                   (AND CHAR
-                        ,test))
-                 (BEGIN
-                   (SET-PARSER-BUFFER-INDEX!
-                    BUFFER
-                    (FIX:+ (PARSER-BUFFER-INDEX BUFFER) 1))
-                   #T)))))))
+            (LET ((CHAR (PEEK-PARSER-BUFFER-CHAR BUFFER)))
+              (AND CHAR
+                   ,test
+                   (BEGIN
+                     (INCREMENT-BUFFER-INDEX! BUFFER CHAR)
+                     #T))))))))
   (char-matcher char (char=? char reference))
   (char-matcher char-ci (char-ci=? char reference))
   (char-matcher not-char (not (char=? char reference)))
                   (PARSER-BUFFER-INDEX BUFFER)
                   (FIX:+ (PARSER-BUFFER-INDEX BUFFER) N))
                  (BEGIN
-                   (SET-PARSER-BUFFER-INDEX!
-                    BUFFER
-                    (FIX:+ (PARSER-BUFFER-INDEX BUFFER) N))
+                   (BUFFER-INDEX+N! BUFFER N)
                    #T)))))))
   (substring-matcher "")
   (substring-matcher "-ci"))
   (substring-matcher "")
   (substring-matcher "-ci"))
 \f
-(define (read-parser-buffer-char buffer)
-  ;; Attempt to read the next character from BUFFER, starting at the
-  ;; current position.  If there is a character available, increment
-  ;; the position and return the character.  If there are no more
-  ;; characters available, return #F and leave the position unchanged.
-  (let ((char (peek-parser-buffer-char buffer)))
-    (if char
-       (begin
-         (set-parser-buffer-index! buffer
-                                   (fix:+ (parser-buffer-index buffer) 1))
-         (if (char=? char #\newline)
-             (set-parser-buffer-line! buffer
-                                      (fix:+ (parser-buffer-line buffer)
-                                             1)))))
-    char))
+(define-integrable (increment-buffer-index! buffer char)
+  (set-parser-buffer-index! buffer (fix:+ (parser-buffer-index buffer) 1))
+  (if (char=? char #\newline)
+      (set-parser-buffer-line! buffer (fix:+ (parser-buffer-line buffer) 1))))
 
-(define (peek-parser-buffer-char buffer)
-  ;; Attempt to read the next character from BUFFER, starting at the
-  ;; current position.  If there is a character available, return it,
-  ;; otherwise return #F.  The position is unaffected in either case.
-  (and (guarantee-buffer-chars buffer 1)
-       (string-ref (parser-buffer-string buffer)
-                  (parser-buffer-index buffer))))
+(define (buffer-index+n! buffer n)
+  (let ((i (parser-buffer-index buffer))
+       (s (parser-buffer-string buffer)))
+    (let ((j (fix:+ i n)))
+      (do ((i i (fix:+ i 1)))
+         ((fix:= i j))
+       (if (char=? (string-ref s i) #\newline)
+           (set-parser-buffer-line! buffer
+                                    (fix:+ (parser-buffer-line buffer) 1))))
+      (set-parser-buffer-index! buffer j))))
 
 (define (guarantee-buffer-chars buffer n)
   (let ((min-end (fix:+ (parser-buffer-index buffer) n))