Implement LIST-PARSER-VALS-REF and LIST-PARSER-VALS-LENGTH.

diff --git a/v7/src/runtime/list-parser.scm b/v7/src/runtime/list-parser.scm
index c5685b0406b052c02eb7d868821d30ea157284f2..469520e6220a6dbc80773759084324c79d663df3 100644 (file)
--- a/v7/src/runtime/list-parser.scm
+++ b/v7/src/runtime/list-parser.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: list-parser.scm,v 1.2 2008/09/03 05:53:44 cph Exp $
+$Id: list-parser.scm,v 1.3 2008/09/03 06:08:16 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -360,7 +360,7 @@ USA.
              names)))
 
 (define name-counters)
-
+\f
 (define (join-vals vals1 vals2)
   `(CONS ,vals1 ,vals2))
 
@@ -384,6 +384,32 @@ USA.
                          k))))
        (k items))))
 
+(define (list-parser-vals-length vals)
+  (if (pair? vals)
+      (let loop ((vals vals))
+       (if (eq? (car vals) single-val-marker)
+           1
+           (+ (loop (car vals))
+              (loop (cdr vals)))))
+      0))
+
+(define (list-parser-vals-ref vals index)
+  (if (not (pair? vals))
+      (error:bad-range-argument index 'LIST-PARSER-VALS-REF))
+  (let loop ((vals vals) (i 0) (stack '()))
+    (if (eq? (car vals) single-val-marker)
+       (if (< i index)
+           (begin
+             (if (not (pair? stack))
+                 (error:bad-range-argument index 'LIST-PARSER-VALS-REF))
+             (loop (car stack)
+                   (+ i 1)
+                   (cdr stack)))
+           (cdr vals))
+       (loop (car vals)
+             i
+             (cons (cdr vals) stack)))))
+
 (define single-val-marker
   '|#[(runtime list-parser)single-val-marker]|)
 \f

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 9d488f386f4a63bf6fc92efe7df7026e8acc2e35..5575a5524c82b82831cb7781e1cd0fcab6b084bc 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.671 2008/09/03 05:53:47 cph Exp $
+$Id: runtime.pkg,v 14.672 2008/09/03 06:08:19 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -5282,6 +5282,8 @@ USA.
   (export ()
          list-parser
          list-parser-vals->list
+         list-parser-vals-length
+         list-parser-vals-ref
          wrap-list-parser))
 
 (define-package (runtime postgresql)