From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Nov 2006 20:07:42 +0000 (+0000)
Subject: Change bnodes so they don't carry their names around. Instead,
X-Git-Tag: 20090517-FFI~844
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b86ccc4ef46396bf0fe5b9535fc020004bd0b5f0;p=mit-scheme.git
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 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)