From 073f5050f015d081842c65e8e6e7877ccabfd7a6 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 17 Jan 2007 03:39:42 +0000
Subject: [PATCH] Add utility procedures for matching and parsing.

---
 v7/src/runtime/parser-buffer.scm | 32 +++++++++++++++++++++++++++++---
 v7/src/runtime/runtime.pkg       | 10 +++++++++-
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/v7/src/runtime/parser-buffer.scm b/v7/src/runtime/parser-buffer.scm
index 4842c24b8..0d9a6b4fe 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.19 2007/01/17 02:48:51 cph Exp $
+$Id: parser-buffer.scm,v 1.20 2007/01/17 03:39:35 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -29,8 +29,6 @@ USA.
 
 (declare (usual-integrations))
 
-;;;; Parser buffer abstraction
-
 (define-structure parser-buffer
   ;; The string buffer, as a substring:
   string
@@ -82,6 +80,34 @@ USA.
   (make-parser-buffer (make-wide-string min-length) 0 0 0 0 port #f 0))
 
 (define-integrable min-length 256)
+
+(define (complete-*match matcher buffer)
+  (and (matcher buffer)
+       (not (peek-parser-buffer-char buffer))))
+
+(define (*match-string matcher string #!optional start end)
+  (complete-*match matcher (string->parser-buffer string start end)))
+
+(define (*match-utf8-string matcher string #!optional start end)
+  (complete-*match matcher (utf8-string->parser-buffer string start end)))
+
+(define (*match-symbol matcher symbol)
+  (*match-utf8-string matcher (symbol-name symbol)))
+
+(define (complete-*parse parser buffer)
+  (let ((v (parser buffer)))
+    (and v
+	 (not (peek-parser-buffer-char buffer))
+	 v)))
+
+(define (*parse-string parser string #!optional start end)
+  (complete-*parse parser (string->parser-buffer string start end)))
+
+(define (*parse-utf8-string parser string #!optional start end)
+  (complete-*parse parser (utf8-string->parser-buffer string start end)))
+
+(define (*parse-symbol parser symbol)
+  (*parse-utf8-string parser (symbol-name symbol)))
 
 (define-structure parser-buffer-pointer
   (index #f read-only #t)
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 253334daa..2aace2f52 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.611 2007/01/17 02:48:57 cph Exp $
+$Id: runtime.pkg,v 14.612 2007/01/17 03:39:42 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -4765,7 +4765,15 @@ USA.
   (parent (runtime))
   (export ()
 	  (match-utf8-char-in-alphabet match-parser-buffer-char-in-alphabet)
+	  *match-string
+	  *match-symbol
+	  *match-utf8-string
+	  *parse-string
+	  *parse-symbol
+	  *parse-utf8-string
 	  call-with-parser-buffer-tail
+	  complete-*match
+	  complete-*parse
 	  discard-parser-buffer-head!
 	  get-parser-buffer-pointer
 	  get-parser-buffer-tail
-- 
2.25.1