From b86ccc4ef46396bf0fe5b9535fc020004bd0b5f0 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Nov 2006 20:07:42 +0000
Subject: [PATCH] Change bnodes so they don't carry their names around. 
 Instead, generate the names on demand from their hash numbers, which
 guarantees uniqueness without a lot of digits.  As a corollary this obviates
 the bnode "handle" mechanism, so that's removed.

---
 v7/src/xml/rdf-nt.scm     |  13 +++-
 v7/src/xml/rdf-struct.scm | 122 ++++++++++++--------------------------
 v7/src/xml/xml.pkg        |   5 +-
 3 files changed, 50 insertions(+), 90 deletions(-)

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index 3b0a13371..ffe1167da 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.10 2006/10/29 06:17:49 cph Exp $
+$Id: rdf-nt.scm,v 1.11 2006/11/09 20:07:38 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -102,6 +102,17 @@ USA.
      (seq "_:"
 	  (match match-bnode-name)))))
 
+(define match-bnode-name
+  (let* ((name-head
+	  (char-set-union (ascii-range->char-set #x41 #x5B)
+			  (ascii-range->char-set #x61 #x7B)))
+	 (name-tail
+	  (char-set-union name-head
+			  (ascii-range->char-set #x30 #x3A))))
+    (*matcher
+     (seq (char-set name-head)
+	  (* (char-set name-tail))))))
+
 (define parse-literal
   (*parser
    (encapsulate (lambda (v)
diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index 43870a6e3..1311622f5 100644
--- 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.21 2006/11/09 19:43:54 cph Exp $
+$Id: rdf-struct.scm,v 1.22 2006/11/09 20:07:40 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -43,7 +43,7 @@ USA.
 
 (define (canonicalize-rdf-subject subject #!optional caller)
   (cond ((rdf-bnode? subject) subject)
-	((%decode-bnode-uri subject caller))
+	((%decode-bnode-uri subject))
 	(else (canonicalize-rdf-uri subject caller))))
 
 (define (canonicalize-rdf-predicate predicate #!optional caller)
@@ -62,9 +62,8 @@ USA.
 ;;;; Blank nodes
 
 (define-record-type <rdf-bnode>
-    (%make-rdf-bnode name)
-    rdf-bnode?
-  (name rdf-bnode-name))
+    (%make-rdf-bnode)
+    rdf-bnode?)
 
 (define-guarantee rdf-bnode "RDF bnode")
 
@@ -72,66 +71,41 @@ USA.
   (standard-unparser-method 'RDF-BNODE
     (lambda (bnode port)
       (write-char #\space port)
-      (write-rdf/nt-bnode bnode port))))
+      (write-string (rdf-bnode-name bnode) port))))
 
 (define (make-rdf-bnode #!optional name)
   (if (default-object? name)
-      (let ((name (generate-bnode-name)))
-	(let ((bnode (%make-rdf-bnode name)))
-	  (hash-table/put! *rdf-bnode-registry* name bnode)
-	  bnode))
+      (%make-rdf-bnode)
       (begin
 	(guarantee-string name 'MAKE-RDF-BNODE)
-	(hash-table/intern! *rdf-bnode-registry*
-	    (string-append "X" name)
-	  make-rdf-bnode))))
-
-(define (generate-bnode-name)
-  (let loop ()
-    (let ((name
-	   (string-append "B"
-			  (vector-8b->hexadecimal (random-byte-vector 8)))))
-      (if (hash-table/get *rdf-bnode-registry* name #f)
-	  (loop)
-	  name))))
-
-(define (%decode-bnode-uri uri caller)
-  (let ((lookup
-	 (lambda (uri)
-	   (let ((bnode
-		  (hash-table/get *rdf-bnode-registry*
-				  (string-tail uri 2)
-				  #f)))
-	     (if (not bnode)
-		 (error:bad-range-argument uri caller))
-	     bnode))))
-    (let ((handle-uri
-	   (lambda (uri)
-	     (cond ((complete-match match-bnode-uri uri) (lookup uri))
-		   ((handle->rdf-bnode uri #f))
-		   (else #f)))))
-      (cond ((string? uri) (handle-uri uri))
-	    ((symbol? uri) (handle-uri (symbol-name uri)))
-	    (else #f)))))
-
-(define (complete-match matcher string)
-  (let ((buffer (string->parser-buffer string)))
-    (and (matcher buffer)
-	 (not (peek-parser-buffer-char buffer)))))
+	(hash-table/intern! *rdf-bnode-registry* name %make-rdf-bnode))))
 
-(define match-bnode-uri
-  (*matcher (seq "_:" match-bnode-name)))
+(define (rdf-bnode-name bnode)
+  (string-append bnode-prefix (number->string (hash bnode))))
 
-(define match-bnode-name
-  (let* ((name-head
-	  (char-set-union (ascii-range->char-set #x41 #x5B)
-			  (ascii-range->char-set #x61 #x7B)))
-	 (name-tail
-	  (char-set-union name-head
-			  (ascii-range->char-set #x30 #x3A))))
-    (*matcher
-     (seq (char-set name-head)
-	  (* (char-set name-tail))))))
+(define (%decode-bnode-uri uri)
+  (let ((handle-uri
+	 (lambda (uri)
+	   (let ((v
+		  (and (string? uri)
+		       (parse-bnode (string->parser-buffer uri)))))
+	     (and v
+		  (unhash (vector-ref v 0)))))))
+    (cond ((string? uri) (handle-uri uri))
+	  ((symbol? uri) (handle-uri (symbol-name uri)))
+	  (else #f))))
+
+(define parse-bnode
+  (let ((prefix (lambda (b) (match-parser-buffer-string b bnode-prefix)))
+	(digits (ascii-range->char-set #x30 #x3A)))
+    (*parser
+     (seq (noise prefix)
+	  (map (lambda (s) (string->number s 10 #t))
+	       (match (+ (char-set digits))))
+	  (noise (end-of-input))))))
+
+(define bnode-prefix
+  "_:B")
 
 (define (make-rdf-bnode-registry)
   (make-string-hash-table))
@@ -147,33 +121,6 @@ USA.
 
 (define (port/drop-rdf-bnode-registry port)
   (port/remove-property! port 'RDF-BNODE-REGISTRY))
-
-(define (rdf-bnode->handle bnode)
-  (string-append bnode-handle-prefix (number->string (hash bnode))))
-
-(define (handle->rdf-bnode handle #!optional caller)
-  (let ((v
-	 (and (string? handle)
-	      (parse-bnode-handle (string->parser-buffer handle)))))
-    (if v
-	(unhash (vector-ref v 0))
-	(begin
-	  (if caller
-	      (error:wrong-type-argument handle "RDF bnode handle" caller))
-	  #f))))
-
-(define parse-bnode-handle
-  (let ((prefix
-	 (lambda (b) (match-parser-buffer-string b bnode-handle-prefix)))
-	(digits (ascii-range->char-set #x30 #x3A)))
-    (*parser
-     (seq (noise prefix)
-	  (map (lambda (s) (string->number s 10 #t))
-	       (match (+ (char-set digits))))
-	  (noise (end-of-input))))))
-
-(define bnode-handle-prefix
-  "_bnode_:")
 
 ;;;; Literals
 
@@ -201,6 +148,11 @@ USA.
 			 type
 			 (->absolute-uri type 'RDF-LITERAL))))
 
+(define (complete-match matcher string)
+  (let ((buffer (string->parser-buffer string)))
+    (and (matcher buffer)
+	 (not (peek-parser-buffer-char buffer)))))
+
 (define match-language
   (let* ((language-head (ascii-range->char-set #x61 #x7B))
 	 (language-tail
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 911a668b3..fe85e7049 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.87 2006/11/04 20:23:19 riastradh Exp $
+$Id: xml.pkg,v 1.88 2006/11/09 20:07:42 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -554,7 +554,6 @@ USA.
 	  guarantee-rdf-prefix-registry
 	  guarantee-rdf-qname
 	  guarantee-rdf-triple
-	  handle->rdf-bnode
 	  make-rdf-bnode-registry
 	  make-rdf-bnode
 	  make-rdf-index
@@ -567,7 +566,6 @@ USA.
 	  port/rdf-bnode-registry
 	  port/rdf-prefix-registry
 	  port/set-rdf-prefix-registry
-	  rdf-bnode->handle
 	  rdf-bnode-name
 	  rdf-bnode?
 	  rdf-index-objects
@@ -597,7 +595,6 @@ USA.
 	  uri->rdf-qname)
   (export (runtime rdf)
 	  %make-rdf-literal
-	  match-bnode-name
 	  match-language))
 
 (define-package (runtime rdf nt)
-- 
2.25.1