Implement interning of bnodes. Implement file-level input procedures.

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index f859abb68b35109d2c93a67959adc742236024d4..53db0c67a21d269143bc4c7cedcac598c0c09425 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.1 2006/02/18 04:31:47 cph Exp $
+$Id: rdf-nt.scm,v 1.2 2006/02/24 17:47:25 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -29,7 +29,33 @@ USA.
 \f
 ;;;; Decoder
 
+(define (read-rdf/nt-file pathname)
+  (fluid-let ((*bnodes* (make-bnode-table)))
+    (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)
+  (fluid-let ((*bnodes* (make-bnode-table)))
+    (let ((port (open-input-file pathname)))
+      (lambda ()
+       (let ((triple (%read-rdf/nt port)))
+         (if (eof-object? triple)
+             #f
+             triple))))))
+
 (define (read-rdf/nt port)
+  (fluid-let ((*bnodes* (bnode-table port)))
+    (let ((triple (%read-rdf/nt port)))
+      (if (eof-object? triple)
+         (drop-bnode-table port))
+      triple)))
+
+(define (%read-rdf/nt port)
   (let loop ()
     (let ((line (read-line port)))
       (if (eof-object? line)
@@ -40,7 +66,7 @@ USA.
            (if (fix:= (vector-length v) 0)
                (loop)
                (vector-ref v 0)))))))
-
+\f
 (define parse-one-line
   (*parser
    (complete
@@ -70,7 +96,7 @@ USA.
 
 (define parse-node-id
   (*parser
-   (encapsulate (lambda (v) (make-rdf-bnode (vector-ref v 0)))
+   (encapsulate (lambda (v) (make-bnode (vector-ref v 0)))
      (seq "_:"
          (match match-bnode-name)))))
 
@@ -137,6 +163,25 @@ USA.
     (port/set-coding port 'UTF-8)
     (loop)))
 \f
+(define *bnodes*)
+
+(define (make-bnode-table)
+  (make-string-hash-table))
+
+(define (bnode-table port)
+  (or (port/get-property port 'BNODE-TABLE #f)
+      (let ((table (make-string-hash-table)))
+       (port/set-property! port 'BNODE-TABLE table)
+       table)))
+
+(define (drop-bnode-table port)
+  (port/remove-property! port 'BNODE-TABLE))
+
+(define (make-bnode name)
+  (hash-table/intern! *bnodes* name
+    (lambda ()
+      (make-rdf-bnode name))))
+
 (define match-language
   (*matcher
    (seq (+ (char-set char-set:language-head))

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index a9753e203edb4ad4e19c0b8aafe582ef2a8965c1..c9d49f677f3f70c603f2c1dcf79766a4d2f94100 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.64 2006/02/18 04:31:55 cph Exp $
+$Id: xml.pkg,v 1.65 2006/02/24 17:47:26 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -556,4 +556,6 @@ USA.
   (parent (runtime rdf))
   (export ()
          read-rdf/nt
+         read-rdf/nt-file
+         rdf/nt-file->source
          write-rdf/nt))
\ No newline at end of file