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.

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index 3b0a13371034069d33189970a5fc8361ee23f8e3..ffe1167da6e4c5218f788d507bf9bdd9ea235e1e 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.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 43870a6e38d0bb4e7bb289778c7577096749bd78..1311622f556210e1fe86a457a9613e7cf3ec5586 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.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)))))
-\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_:")
 \f
 ;;;; 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 911a668b30af8ed2c5ad93c2ae33033e4ff988eb..fe85e7049c576aa10a475abbcd06c5e7c090c639 100644 (file)
--- 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)