Add rdf-index type to rdf-struct. Move MATCH-BNODE-NAME and

MATCH-LANGUAGE into rdf-struct.  Change bnode language to be a symbol
rather than a string.

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index 46e9951c2174db9f775e02dd82c8740396121978..6d55654c782d6d75c12c94b6d5c6b1333278469a 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.4 2006/03/07 02:51:08 cph Exp $
+$Id: rdf-nt.scm,v 1.5 2006/03/07 02:52:49 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -238,7 +238,7 @@ USA.
        ((rdf-literal-language literal)
         => (lambda (lang)
              (write-char #\@ port)
-             (write-string lang port)))))
+             (write-string (symbol-name lang) port)))))
 
 (define (write-literal-text text port)
   (let ((text (open-input-string text)))

diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index 9131b701944f2183e884017a5c69b2eecb8eb5ae..25c045fe1d26f208414c0a762d0bf007bc5dcde4 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.3 2006/03/06 02:32:15 cph Exp $
+$Id: rdf-struct.scm,v 1.4 2006/03/07 02:51:12 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -70,7 +70,7 @@ USA.
          (error:wrong-type-argument name "RDF bnode name" 'RDF-BNODE)))))
 
 (define (generate-bnode-name)
-  (vector-8b->hexadecimal (random-byte-vector 8)))
+  (string-append "B" (vector-8b->hexadecimal (random-byte-vector 8))))
 
 (define-record-type <rdf-literal>
     (%make-rdf-literal text type)
@@ -84,8 +84,9 @@ USA.
   (guarantee-utf8-string text 'RDF-LITERAL)
   (%make-rdf-literal text
                     (if (or (not type)
-                            (and (string? type)
-                                 (complete-match match-language type)))
+                            (and (symbol? type)
+                                 (complete-match match-language
+                                                 (symbol-name type))))
                         type
                         (->absolute-uri type 'RDF-LITERAL))))
 
@@ -98,8 +99,57 @@ USA.
   (let ((type (%rdf-literal-type literal)))
     (and (not (absolute-uri? type))
         type)))
-
-(define (complete-match matcher string #!optional start end)
-  (let ((buffer (string->parser-buffer string start end)))
+\f
+(define-record-type <rdf-index>
+    (%make-rdf-index subjects predicates objects)
+    rdf-index?
+  (subjects rdf-index-subjects)
+  (predicates rdf-index-predicates)
+  (objects rdf-index-objects))
+
+(define-guarantee rdf-index "RDF index")
+
+(define (make-rdf-index)
+  (%make-rdf-index (make-eq-hash-table)
+                  (make-eq-hash-table)
+                  (make-eq-hash-table)))
+
+(define (add-to-rdf-index triple index)
+  (let ((add
+        (lambda (key index)
+          (hash-table/put! index
+                           key
+                           (cons triple
+                                 (hash-table/get index
+                                                 key
+                                                 '()))))))
+    (add (rdf-triple-subject triple) (rdf-index-subjects index))
+    (add (rdf-triple-predicate triple) (rdf-index-predicates index))
+    (let ((o (rdf-triple-object triple)))
+      (if (not (rdf-literal? o))
+         (add o (rdf-index-objects index))))))
+
+(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 match-language
+  (let* ((language-head (ascii-range->char-set #x61 #x7B))
+        (language-tail
+         (char-set-union language-head
+                         (ascii-range->char-set #x30 #x3A))))
+    (*matcher
+     (seq (+ (char-set language-head))
+         (* (seq #\- (+ (char-set language-tail))))))))
+
+(define (complete-match matcher string)
+  (let ((buffer (string->parser-buffer string)))
     (and (matcher buffer)
         (not (peek-parser-buffer-char buffer)))))
\ No newline at end of file

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index c9d49f677f3f70c603f2c1dcf79766a4d2f94100..6acb6037f715dc93d09e112cf3c2304dfa7ad78b 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.65 2006/02/24 17:47:26 cph Exp $
+$Id: xml.pkg,v 1.66 2006/03/07 02:51:16 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -526,19 +526,28 @@ USA.
   (parent (runtime rdf))
   (export ()
          <rdf-bnode>
+         <rdf-index>
          <rdf-literal>
          <rdf-triple>
+         add-to-rdf-index
          error:not-rdf-bnode
+         error:not-rdf-index
          error:not-rdf-literal
          error:not-rdf-triple
          guarantee-rdf-bnode
+         guarantee-rdf-index
          guarantee-rdf-literal
          guarantee-rdf-triple
          make-rdf-bnode
+         make-rdf-index
          make-rdf-literal
          make-rdf-triple
          rdf-bnode-name
          rdf-bnode?
+         rdf-index-objects
+         rdf-index-predicates
+         rdf-index-subjects
+         rdf-index?
          rdf-literal-language
          rdf-literal-text
          rdf-literal-type
@@ -548,6 +557,7 @@ USA.
          rdf-triple-subject
          rdf-triple?)
   (export (runtime rdf nt)
+         %make-rdf-literal
          match-bnode-name
          match-language))