From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 10 Jun 2006 04:06:47 +0000 (+0000)
Subject: Implement PARSER-BUFFER-ERROR.
X-Git-Tag: 20090517-FFI~1026
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fc9ddcf04a2db90611a912e141b21d4f59f47245;p=mit-scheme.git

Implement PARSER-BUFFER-ERROR.
---

diff --git a/v7/src/runtime/parser-buffer.scm b/v7/src/runtime/parser-buffer.scm
index 7bd1da869..9cf987551 100644
--- a/v7/src/runtime/parser-buffer.scm
+++ b/v7/src/runtime/parser-buffer.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parser-buffer.scm,v 1.15 2006/01/31 17:43:37 cph Exp $
+$Id: parser-buffer.scm,v 1.16 2006/06/10 04:06:47 cph Exp $
 
 Copyright 2001,2002,2003,2004,2006 Massachusetts Institute of Technology
 
@@ -126,6 +126,14 @@ USA.
      ", char "
      (number->string (+ (parser-buffer-pointer-index pointer) 1)))))
 
+(define (parser-buffer-error ptr msg . irritants)
+  (apply error
+	 (string-append msg
+			" at "
+			(parser-buffer-position-string ptr)
+			(if (pair? irritants) ":" "."))
+	 irritants))
+
 (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
@@ -152,7 +160,7 @@ USA.
   (and (guarantee-buffer-chars buffer (fix:+ index 1))
        (%wide-string-ref (parser-buffer-string buffer)
 			 (fix:+ (parser-buffer-index buffer) index))))
-
+
 (define (match-parser-buffer-char buffer char)
   (match-char buffer char char=?))
 
@@ -176,7 +184,7 @@ USA.
 
 (define (match-parser-buffer-not-char-ci-no-advance buffer char)
   (match-char-not-no-advance buffer char char-ci=?))
-
+
 (define (match-parser-buffer-char-in-set buffer set)
   (match-char buffer set char-in-set?))
 
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index e8783f65c..4f757f83b 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.582 2006/03/10 01:46:20 cph Exp $
+$Id: runtime.pkg,v 14.583 2006/06/10 04:06:47 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -4643,6 +4643,7 @@ USA.
   (files "parser-buffer")
   (parent (runtime))
   (export ()
+	  (match-utf8-char-in-alphabet match-parser-buffer-char-in-alphabet)
 	  call-with-parser-buffer-tail
 	  discard-parser-buffer-head!
 	  get-parser-buffer-pointer
@@ -4672,7 +4673,7 @@ USA.
 	  match-parser-buffer-substring-ci
 	  match-parser-buffer-substring-ci-no-advance
 	  match-parser-buffer-substring-no-advance
-	  (match-utf8-char-in-alphabet match-parser-buffer-char-in-alphabet)
+	  parser-buffer-error
 	  parser-buffer-line
 	  parser-buffer-pointer-index
 	  parser-buffer-pointer-line