From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 11 Jul 2001 00:41:55 +0000 (+0000)
Subject: New procedure PARSER-BUFFER-REF.
X-Git-Tag: 20090517-FFI~2664
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7eec5c5c39a311e85a529793a5622a030150f483;p=mit-scheme.git

New procedure PARSER-BUFFER-REF.
---

diff --git a/v7/src/star-parser/buffer.scm b/v7/src/star-parser/buffer.scm
index 28b872d8e..1871de68f 100644
--- a/v7/src/star-parser/buffer.scm
+++ b/v7/src/star-parser/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.7 2001/07/05 18:51:23 cph Exp $
+;;; $Id: buffer.scm,v 1.8 2001/07/11 00:41:50 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -131,6 +131,13 @@
   (and (guarantee-buffer-chars buffer 1)
        (string-ref (parser-buffer-string buffer)
 		   (parser-buffer-index buffer))))
+
+(define (parser-buffer-ref buffer index)
+  (if (not (index-fixnum? index))
+      (error:wrong-type-argument index "index" '???))
+  (and (guarantee-buffer-chars buffer (fix:+ index 1))
+       (string-ref (parser-buffer-string buffer)
+		   (fix:+ (parser-buffer-index buffer) index))))
 
 (let-syntax
     ((char-matcher
diff --git a/v7/src/star-parser/load.scm b/v7/src/star-parser/load.scm
index e03ab3990..6d7ae6e41 100644
--- a/v7/src/star-parser/load.scm
+++ b/v7/src/star-parser/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.4 2001/07/02 18:21:01 cph Exp $
+;;; $Id: load.scm,v 1.5 2001/07/11 00:41:52 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -24,4 +24,4 @@
   (lambda ()
     (fluid-let ((*allow-package-redefinition?* #t))
       (package/system-loader "parser" '() 'QUERY))))
-(add-subsystem-identification! "*Parser" '(0 4))
\ No newline at end of file
+(add-subsystem-identification! "*Parser" '(0 5))
\ No newline at end of file
diff --git a/v7/src/star-parser/parser.pkg b/v7/src/star-parser/parser.pkg
index c0f532f9a..6da877b57 100644
--- a/v7/src/star-parser/parser.pkg
+++ b/v7/src/star-parser/parser.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: parser.pkg,v 1.5 2001/07/02 18:20:47 cph Exp $
+;;; $Id: parser.pkg,v 1.6 2001/07/11 00:41:55 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -54,6 +54,7 @@
 	  parser-buffer-pointer-line
 	  parser-buffer-pointer?
 	  parser-buffer-position-string
+	  parser-buffer-ref
 	  parser-buffer?
 	  peek-parser-buffer-char
 	  read-parser-buffer-char