From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 19 Oct 2006 17:48:26 +0000 (+0000)
Subject: Do a better job distinguishing procedures that generate RDF/NT syntax.
X-Git-Tag: 20090517-FFI~890
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6005908f41ac99cf4c4cc9e90817d180f0f9d051;p=mit-scheme.git

Do a better job distinguishing procedures that generate RDF/NT syntax.
Previously these were referred to by generic names.
---

diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm
index 0c8054ed2..b9b4c2f5e 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.8 2006/08/02 05:05:10 cph Exp $
+$Id: rdf-nt.scm,v 1.9 2006/10/19 17:48:21 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -193,50 +193,49 @@ USA.
 
 (define (write-rdf/nt triple port)
   (let ((s (rdf-triple-subject triple)))
-    (cond ((uri? s) (write-rdf-uri-ref s port))
-	  ((rdf-bnode? s) (write-rdf-bnode s port))))
-  (write-char #\space port)
-  (write-rdf-uri-ref (rdf-triple-predicate triple) port)
-  (write-char #\space port)
+    (cond ((uri? s) (write-rdf/nt-uri s port))
+	  ((rdf-bnode? s) (write-rdf/nt-bnode s port))))
+  (write-string " " port)
+  (write-rdf/nt-uri (rdf-triple-predicate triple) port)
+  (write-string " " port)
   (let ((o (rdf-triple-object triple)))
-    (cond ((uri? o) (write-rdf-uri-ref o port))
-	  ((rdf-bnode? o) (write-rdf-bnode o port))
-	  ((rdf-literal? o) (write-rdf-literal o port))))
-  (write-char #\space port)
-  (write-char #\. port)
+    (cond ((uri? o) (write-rdf/nt-uri o port))
+	  ((rdf-bnode? o) (write-rdf/nt-bnode o port))
+	  ((rdf-literal? o) (write-rdf/nt-literal o port))))
+  (write-string " ." port)
   (newline port))
 
-(define (write-rdf-uri-ref uri port)
-  (write-char #\< port)
+(define (write-rdf/nt-uri uri port)
+  (write-string "<" port)
   (write-uri uri port)
-  (write-char #\> port))
+  (write-string ">" port))
 
-(define (write-rdf-bnode bnode port)
+(define (write-rdf/nt-bnode bnode port)
   (write-string "_:" port)
   (write-string (rdf-bnode-name bnode) port))
 
-(define (write-rdf-literal literal port)
-  (write-char #\" port)
-  (write-literal-text (rdf-literal-text literal) port)
-  (write-char #\" port)
+(define (write-rdf/nt-literal literal port)
+  (write-rdf/nt-literal-text (rdf-literal-text literal) port)
   (cond ((rdf-literal-type literal)
 	 => (lambda (uri)
 	      (write-string "^^" port)
-	      (write-rdf-uri-ref uri port)))
+	      (write-rdf/nt-uri uri port)))
 	((rdf-literal-language literal)
 	 => (lambda (lang)
-	      (write-char #\@ port)
+	      (write-string "@" port)
 	      (write-string (symbol-name lang) port)))))
 
-(define (write-literal-text text port)
+(define (write-rdf/nt-literal-text text port)
   (let ((text (open-input-string text)))
     (port/set-coding text 'UTF-8)
+    (write-string "\"" port)
     (let loop ()
       (let ((char (read-char text)))
 	(if (not (eof-object? char))
 	    (begin
 	      (write-literal-char char port)
-	      (loop)))))))
+	      (loop)))))
+    (write-string "\"" port)))
 
 (define (write-literal-char char port)
   (if (char-set-member? char-set:unescaped char)
diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index dc676d1cd..4d37677a0 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.17 2006/10/19 15:20:33 cph Exp $
+$Id: rdf-struct.scm,v 1.18 2006/10/19 17:48:23 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -58,12 +58,6 @@ USA.
   (if (rdf-qname? uri)
       (rdf-qname->uri uri)
       (->absolute-uri uri caller)))
-
-(define (write-rdf-uri uri port)
-  (let ((qname (uri->rdf-qname uri #f)))
-    (if qname
-	(write-string (symbol-name qname) port)
-	(write-rdf-uri-ref uri port))))
 
 ;;;; Blank nodes
 
@@ -78,7 +72,7 @@ USA.
   (standard-unparser-method 'RDF-BNODE
     (lambda (bnode port)
       (write-char #\space port)
-      (write-rdf-bnode bnode port))))
+      (write-rdf/nt-bnode bnode port))))
 
 (define (make-rdf-bnode #!optional name)
   (cond ((default-object? name)
@@ -197,7 +191,7 @@ USA.
   (standard-unparser-method 'RDF-LITERAL
     (lambda (literal port)
       (write-char #\space port)
-      (write-rdf-literal literal port))))
+      (write-rdf/nt-literal literal port))))
 
 (define (make-rdf-literal text type)
   (guarantee-utf8-string text 'RDF-LITERAL)
diff --git a/v7/src/xml/turtle.scm b/v7/src/xml/turtle.scm
index 5d686ebbf..5ae586f80 100644
--- a/v7/src/xml/turtle.scm
+++ b/v7/src/xml/turtle.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: turtle.scm,v 1.8 2006/10/19 15:22:23 cph Exp $
+$Id: turtle.scm,v 1.9 2006/10/19 17:48:24 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -560,18 +560,15 @@ USA.
   (call-with-output-file pathname
     (lambda (port)
       (port/set-coding port 'UTF-8)
-      (write-rdf/turtle triples port))))
-
-(define (write-rdf/turtle triples #!optional port)
-  (write-prefixes triples port)
-  (receive (uris bnodes) (sort-triples-by-subject triples)
-    (receive (inline separate) (split-bnodes-by-nrefs bnodes triples)
-      (for-each (lambda (ts)
-		  (write-subject ts inline port))
-		uris)
-      (for-each (lambda (ts)
-		  (write-subject ts inline port))
-		separate))))
+      (write-prefixes triples port)
+      (receive (uris bnodes) (sort-triples-by-subject triples)
+	(receive (inline separate) (split-bnodes-by-nrefs bnodes triples)
+	  (for-each (lambda (ts)
+		      (write-subject ts inline port))
+		    uris)
+	  (for-each (lambda (ts)
+		      (write-subject ts inline port))
+		    separate))))))
 
 (define (write-prefixes triples port)
   (let ((table (make-eq-hash-table)))
@@ -598,14 +595,20 @@ USA.
 (define (write-subject triples bnodes port)
   (newline port)
   (let ((s (rdf-triple-subject (car triples))))
-    (cond ((uri? s) (write-rdf-uri s port))
-	  ((rdf-bnode? s) (write-rdf-bnode s port))
+    (cond ((uri? s) (write-rdf/turtle-uri s port))
+	  ((rdf-bnode? s) (write-rdf/nt-bnode s port))
 	  (else (error "Unknown RDF subject:" s))))
   (write-string " " port)
   (write-properties triples bnodes 1 port)
   (write-string "." port)
   (newline port))
-
+
+(define (write-rdf/turtle-uri uri port)
+  (let ((qname (uri->rdf-qname uri #f)))
+    (if qname
+	(write-string (symbol-name qname) port)
+	(write-rdf/nt-uri uri port))))
+
 (define (write-properties triples bnodes indentation port)
   (let ((triples (sort triples triple<?)))
     (write-property (car triples) bnodes indentation port)
@@ -622,79 +625,69 @@ USA.
 	 (if (eq? p1 rdf:type)
 	     #t
 	     (string<? (uri->string p1) (uri->string p2))))))
-
+
 (define (write-property t bnodes indentation port)
   (let ((p (rdf-triple-predicate t)))
     (if (eq? p rdf:type)
 	(write-string "a" port)
-	(write-rdf-uri p port)))
+	(write-rdf/turtle-uri p port)))
   (write-string " " port)
   (let ((o (rdf-triple-object t)))
-    (cond ((uri? o)
-	   (write-rdf-uri o port))
-	  ((rdf-literal? o)
-	   (if (let ((type (rdf-literal-type o)))
-		 (or (eq? type xsd:boolean)
-		     (eq? type xsd:decimal)
-		     (eq? type xsd:double)
-		     (eq? type xsd:integer)))
-	       (write-string (rdf-literal-text o) port)
-	       (write-literal o port)))
-	  ((rdf-bnode? o)
-	   (let ((ts
-		  (find-matching-item bnodes
-		    (lambda (ts)
-		      (eq? (rdf-triple-subject (car ts)) o)))))
-	     (if ts
-		 (write-inline-bnode ts bnodes indentation port)
-		 (write-rdf-bnode o port))))
-	  (else
-	   (error "Unknown RDF object:" o))))
+    (cond ((uri? o) (write-rdf/turtle-uri o port))
+	  ((rdf-literal? o) (write-literal o port))
+	  ((rdf-bnode? o) (write-bnode o bnodes indentation port))
+	  (else (error "Unknown RDF object:" o))))
   (newline port))
 
-(define (write-inline-bnode triples bnodes indentation port)
-  (write-string "[" port)
-  (newline port)
-  (write-indentation (+ indentation 1) port)
-  (write-properties triples bnodes (+ indentation 1) port)
-  (write-indentation indentation port)
-  (write-string "]" port))
-
+(define (write-bnode bnode bnodes indentation port)
+  (let ((ts
+	 (find-matching-item bnodes
+	   (lambda (ts)
+	     (eq? (rdf-triple-subject (car ts)) bnode)))))
+    (if ts
+	(begin
+	  (write-string "[" port)
+	  (newline port)
+	  (write-indentation (+ indentation 1) port)
+	  (write-properties ts bnodes (+ indentation 1) port)
+	  (write-indentation indentation port)
+	  (write-string "]" port))
+	(write-rdf/nt-bnode bnode port))))
+
 (define (write-literal literal port)
-  (write-literal-text (rdf-literal-text literal) port)
-  (cond ((rdf-literal-type literal)
-	 => (lambda (uri)
-	      (write-string "^^" port)
-	      (write-rdf-uri uri port)))
-	((rdf-literal-language literal)
-	 => (lambda (lang)
-	      (write-char #\@ port)
-	      (write-string (symbol-name lang) port)))))
+  (let ((text (rdf-literal-text literal)))
+    (if (let ((type (rdf-literal-type literal)))
+	  (or (eq? type xsd:boolean)
+	      (eq? type xsd:decimal)
+	      (eq? type xsd:double)
+	      (eq? type xsd:integer)))
+	(write-string text port)
+	(begin
+	  (write-literal-text text port)
+	  (cond ((rdf-literal-type literal)
+		 => (lambda (uri)
+		      (write-string "^^" port)
+		      (write-rdf/turtle-uri uri port)))
+		((rdf-literal-language literal)
+		 => (lambda (lang)
+		      (write-string "@" port)
+		      (write-symbol lang port))))))))
 
 (define (write-literal-text text port)
-  (let ((tport (open-input-string text)))
-    (port/set-coding tport 'UTF-8)
-    (if (string-find-next-char text #\newline)
-	(begin
-	  (write-string "\"\"\"" port)
-	  (let loop ()
-	    (let ((char (read-char tport)))
-	      (if (not (eof-object? char))
-		  (begin
-		    (if (char=? char #\newline)
-			(newline port)
-			(write-literal-char char port))
-		    (loop)))))
-	  (write-string "\"\"\"" port))
-	(begin
-	  (write-string "\"" port)
-	  (let loop ()
-	    (let ((char (read-char tport)))
-	      (if (not (eof-object? char))
-		  (begin
-		    (write-literal-char char port)
-		    (loop)))))
-	  (write-string "\"" port)))))
+  (if (string-find-next-char text #\newline)
+      (let ((tport (open-input-string text)))
+	(port/set-coding tport 'UTF-8)
+	(write-string "\"\"\"" port)
+	(let loop ()
+	  (let ((char (read-char tport)))
+	    (if (not (eof-object? char))
+		(begin
+		  (if (char=? char #\newline)
+		      (newline port)
+		      (write-literal-char char port))
+		  (loop)))))
+	(write-string "\"\"\"" port))
+      (write-rdf/nt-literal-text text port)))
 
 (define (sort-triples-by-subject triples)
   (let ((table (make-eq-hash-table)))
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 3061c447e..2da831184 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.81 2006/10/19 15:22:25 cph Exp $
+$Id: xml.pkg,v 1.82 2006/10/19 17:48:26 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -588,8 +588,7 @@ USA.
 	  register-rdf-prefix
 	  split-rdf-qname
 	  uri->rdf-prefix
-	  uri->rdf-qname
-	  write-rdf-uri)
+	  uri->rdf-qname)
   (export (runtime rdf)
 	  %make-rdf-literal
 	  match-bnode-name
@@ -604,21 +603,22 @@ USA.
 	  read-rdf/nt
 	  read-rdf/nt-file
 	  rdf/nt-file->source
-	  write-rdf-bnode
-	  write-rdf-literal
-	  write-rdf-uri-ref
 	  write-rdf/nt
-	  write-rdf/nt-file)
+	  write-rdf/nt-bnode
+	  write-rdf/nt-file
+	  write-rdf/nt-literal
+	  write-rdf/nt-uri)
   (export (runtime rdf turtle)
-	  write-literal-char))
+	  write-literal-char
+	  write-rdf/nt-literal-text))
 
 (define-package (runtime rdf turtle)
   (files "turtle")
   (parent (runtime rdf))
   (export ()
 	  read-rdf/turtle-file
-	  write-rdf/turtle
-	  write-rdf/turtle-file)
+	  write-rdf/turtle-file
+	  write-rdf/turtle-uri)
   (export (runtime rdf)
 	  match:name
 	  match:prefix-name))
\ No newline at end of file