From 30b0bab12fb0ca87df48a310bf871d16ac429a22 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 7 Mar 2006 02:52:49 +0000
Subject: [PATCH] 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.

---
 v7/src/xml/rdf-nt.scm     |  4 +--
 v7/src/xml/rdf-struct.scm | 64 ++++++++++++++++++++++++++++++++++-----
 v7/src/xml/xml.pkg        | 12 +++++++-
 3 files changed, 70 insertions(+), 10 deletions(-)

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index 46e9951c2..6d55654c7 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.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 9131b7019..25c045fe1 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.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)))
+
+(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 c9d49f677..6acb6037f 100644
--- 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))
 
-- 
2.25.1