From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 1 Aug 2006 17:23:50 +0000 (+0000)
Subject: Tweak qname abstraction again.
X-Git-Tag: 20090517-FFI~965
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5692326e0ba17568d323d43f6346b8c0294a9ef8;p=mit-scheme.git

Tweak qname abstraction again.
---

diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index 038671009..48c5f5598 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.14 2006/08/01 02:50:45 cph Exp $
+$Id: rdf-struct.scm,v 1.15 2006/08/01 17:23:49 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -239,19 +239,29 @@ USA.
 	    (if error? (error:bad-range-argument qname 'RDF-QNAME->URI))
 	    #f)))))
 
+(define (make-rdf-qname prefix local)
+  (guarantee-rdf-prefix prefix 'MAKE-RDF-QNAME)
+  (guarantee-string local 'MAKE-RDF-QNAME)
+  (if (not (complete-match match:name local))
+      (error:bad-range-argument local 'MAKE-RDF-QNAME))
+  (symbol prefix local))
+
+(define (rdf-qname-prefix qname)
+  (guarantee-rdf-qname qname 'RDF-QNAME-PREFIX)
+  (let ((s (symbol-name qname)))
+    (symbol (string-head s (fix:+ (string-find-next-char s #\:) 1)))))
+
+(define (rdf-qname-local qname)
+  (guarantee-rdf-qname qname 'RDF-QNAME-LOCAL)
+  (let ((s (symbol-name qname)))
+    (string-tail s (fix:+ (string-find-next-char s #\:) 1))))
+
 (define (split-rdf-qname qname)
   (guarantee-rdf-qname qname 'SPLIT-RDF-QNAME)
   (let ((s (symbol-name qname)))
     (let ((i (fix:+ (string-find-next-char s #\:) 1)))
       (values (symbol (string-head s i))
 	      (string-tail s i)))))
-
-(define (join-rdf-qname prefix local)
-  (guarantee-rdf-prefix prefix 'JOIN-RDF-QNAME)
-  (guarantee-string local 'JOIN-RDF-QNAME)
-  (if (not (complete-match match:name local))
-      (error:bad-range-argument local 'JOIN-RDF-QNAME))
-  (symbol prefix local))
 
 (define (rdf-qname? object)
   (and (interned-symbol? object)
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 114bd0c57..65dab5d01 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.78 2006/08/01 04:23:35 cph Exp $
+$Id: xml.pkg,v 1.79 2006/08/01 17:23:50 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -552,10 +552,10 @@ USA.
 	  guarantee-rdf-prefix-registry
 	  guarantee-rdf-qname
 	  guarantee-rdf-triple
-	  join-rdf-qname
 	  make-rdf-bnode
 	  make-rdf-index
 	  make-rdf-literal
+	  make-rdf-qname
 	  make-rdf-triple
 	  new-rdf-prefix-registry
 	  rdf-bnode-name
@@ -574,6 +574,8 @@ USA.
 	  rdf-prefix-registry?
 	  rdf-prefix?
 	  rdf-qname->uri
+	  rdf-qname-local
+	  rdf-qname-prefix
 	  rdf-qname?
 	  rdf-triple-object
 	  rdf-triple-predicate