From ac1f07923ba62f182d53007e298fa7b7ab5c3ec5 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 Feb 2006 17:47:26 +0000
Subject: [PATCH] Implement interning of bnodes.  Implement file-level input
 procedures.

---
 v7/src/xml/rdf-nt.scm | 51 ++++++++++++++++++++++++++++++++++++++++---
 v7/src/xml/xml.pkg    |  4 +++-
 2 files changed, 51 insertions(+), 4 deletions(-)

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index f859abb68..53db0c67a 100644
--- 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.
 
 ;;;; 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)))))))
-
+
 (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)))
 
+(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 a9753e203..c9d49f677 100644
--- 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
-- 
2.25.1