Simplify bnode-registry mechanism to use a single procedure.

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index b45ae8fb0d4047b28d4faedc6945e8b8471cf7e0..87276789b4e31f6cc33c63624ca153d9a7ea3417 100644 (file)
--- a/v7/src/xml/rdf-nt.scm
+++ b/v7/src/xml/rdf-nt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rdf-nt.scm,v 1.12 2007/01/05 21:19:29 cph Exp $
+$Id: rdf-nt.scm,v 1.13 2007/08/01 00:13:33 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -32,40 +32,31 @@ USA.
 ;;;; Decoder
 
 (define (read-rdf/nt-file pathname)
-  (fluid-let ((*rdf-bnode-registry* (make-rdf-bnode-registry)))
-    (call-with-input-file pathname
-      (lambda (port)
-       (let loop ((triples '()))
-         (let ((triple (%read-rdf/nt port)))
-           (if (eof-object? triple)
-               triples
-               (loop (cons triple triples)))))))))
+  (call-with-input-file pathname
+    (lambda (port)
+      (let loop ((triples '()))
+       (let ((triple (read-rdf/nt port)))
+         (if (eof-object? triple)
+             triples
+             (loop (cons triple triples))))))))
 
 (define (rdf/nt-file->source pathname)
-  (let ((port (open-input-file pathname))
-       (registry (make-rdf-bnode-registry)))
+  (let ((port (open-input-file pathname)))
     (lambda ()
-      (let ((triple
-            (fluid-let ((*rdf-bnode-registry* registry))
-              (%read-rdf/nt port))))
+      (let ((triple (read-rdf/nt port)))
        (if (eof-object? triple)
            #f
            triple)))))
 
 (define (read-rdf/nt port)
-  (fluid-let ((*rdf-bnode-registry* (port/rdf-bnode-registry port)))
-    (let ((triple (%read-rdf/nt port)))
-      (if (eof-object? triple)
-         (port/drop-rdf-bnode-registry port))
-      triple)))
-
-(define (%read-rdf/nt port)
   (let loop ()
     (let ((line (read-line port)))
       (if (eof-object? line)
          line
          (let ((v
-                (or (parse-one-line (string->parser-buffer line))
+                (or (with-rdf-input-port port
+                      (lambda ()
+                        (parse-one-line (string->parser-buffer line))))
                     (error "Failed to parse RDF/NT line:" line))))
            (if (fix:= (vector-length v) 0)
                (loop)
@@ -118,7 +109,7 @@ USA.
 (define parse-literal
   (*parser
    (encapsulate (lambda (v)
-                 (%make-rdf-literal (vector-ref v 0) (vector-ref v 1)))
+                 (make-rdf-literal (vector-ref v 0) (vector-ref v 1)))
      (seq #\"
          parse-string
          #\"

diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index 568e6d52c5b87b94dd498a6076c6b2300d204a99..fcf68c07749ef77ace0f14bd1a712fa0c0de3655 100644 (file)
--- a/v7/src/xml/rdf-struct.scm
+++ b/v7/src/xml/rdf-struct.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rdf-struct.scm,v 1.27 2007/01/17 21:00:48 cph Exp $
+$Id: rdf-struct.scm,v 1.28 2007/08/01 00:13: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,
@@ -101,20 +101,15 @@ USA.
               (match (+ (char-set digits))))
          (noise (end-of-input))))))
 
-(define (make-rdf-bnode-registry)
-  (make-string-hash-table))
+(define (with-rdf-input-port port thunk)
+  (fluid-let ((*rdf-bnode-registry*
+              (or (port/get-property port 'RDF-BNODE-REGISTRY #f)
+                  (let ((table (make-string-hash-table)))
+                    (port/set-property! port 'RDF-BNODE-REGISTRY table)
+                    table))))
+    (thunk)))
 
-(define *rdf-bnode-registry*
-  (make-rdf-bnode-registry))
-
-(define (port/rdf-bnode-registry port)
-  (or (port/get-property port 'RDF-BNODE-REGISTRY #f)
-      (let ((table (make-rdf-bnode-registry)))
-       (port/set-property! port 'RDF-BNODE-REGISTRY table)
-       table)))
-
-(define (port/drop-rdf-bnode-registry port)
-  (port/remove-property! port 'RDF-BNODE-REGISTRY))
+(define *rdf-bnode-registry*)
 \f
 ;;;; Literals
 

diff --git a/v7/src/xml/turtle.scm b/v7/src/xml/turtle.scm
index 9e6ad24833a0988d1d34317908eaa47270890efb..60ffbd8fec0fa071aed5aa5d505276bddeb3269f 100644 (file)
--- a/v7/src/xml/turtle.scm
+++ b/v7/src/xml/turtle.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: turtle.scm,v 1.23 2007/02/22 18:41:18 cph Exp $
+$Id: turtle.scm,v 1.24 2007/08/01 00:13:36 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -36,13 +36,15 @@ USA.
     (call-with-input-file pathname
       (lambda (port)
        (port/set-coding port 'UTF-8)
-       (fluid-let ((*rdf-bnode-registry* (make-rdf-bnode-registry)))
-         (post-process-parser-output
-          (parse-turtle-doc (input-port->parser-buffer port))
-          (if (default-object? base-uri)
-              (pathname->uri (merge-pathnames pathname))
-              (merge-uris (file-namestring pathname)
-                          (->absolute-uri base-uri 'READ-TURTLE-FILE)))))))))
+       (with-rdf-input-port port
+         (lambda ()
+           (post-process-parser-output
+            (parse-turtle-doc (input-port->parser-buffer port))
+            (if (default-object? base-uri)
+                (pathname->uri (merge-pathnames pathname))
+                (merge-uris
+                 (file-namestring pathname)
+                 (->absolute-uri base-uri 'READ-RDF/TURTLE-FILE))))))))))
 
 (define (parse-turtle-doc buffer)
   (parse:ws* buffer)

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 888006e4084fb2744d7b5dce0ce0d9de055f675d..ea5e0cdc520da9e3620dbd1a3105cb43d5c145d1 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.93 2007/07/23 04:12:41 cph Exp $
+$Id: xml.pkg,v 1.94 2007/08/01 00:13:37 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -535,7 +535,6 @@ USA.
   (parent (runtime rdf))
   (export ()
          *default-rdf-prefix-registry*
-         *rdf-bnode-registry*
          <rdf-bnode>
          <rdf-index>
          <rdf-literal>
@@ -561,7 +560,6 @@ USA.
          guarantee-rdf-prefix-registry
          guarantee-rdf-qname
          guarantee-rdf-triple
-         make-rdf-bnode-registry
          make-rdf-bnode
          make-rdf-index
          make-rdf-literal
@@ -569,8 +567,6 @@ USA.
          make-rdf-triple
          merge-rdf-prefix-registry!
          new-rdf-prefix-registry
-         port/drop-rdf-bnode-registry
-         port/rdf-bnode-registry
          port/rdf-prefix-registry
          port/set-rdf-prefix-registry
          rdf-bnode-name
@@ -599,9 +595,9 @@ USA.
          register-rdf-prefix
          split-rdf-qname
          uri->rdf-prefix
-         uri->rdf-qname)
+         uri->rdf-qname
+         with-rdf-input-port)
   (export (runtime rdf)
-         %make-rdf-literal
          match-language))
 
 (define-package (runtime rdf nt)