Change all Turtle procedures to require a prefix-registry argument.

diff --git a/v7/src/xml/turtle.scm b/v7/src/xml/turtle.scm
index d27ade602c0dfb1567eb3f0f872845275557a425..4918d61228d8c96a9ce3c4c7ca03bdecefc20649 100644 (file)
--- a/v7/src/xml/turtle.scm
+++ b/v7/src/xml/turtle.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: turtle.scm,v 1.14 2006/10/27 13:49:15 cph Exp $
+$Id: turtle.scm,v 1.15 2006/10/29 05:32:35 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -29,7 +29,7 @@ USA.
 \f
 ;;;; Decoder
 
-(define (read-rdf/turtle-file pathname #!optional base-uri)
+(define (read-rdf/turtle-file pathname registry #!optional base-uri)
   (let ((pathname (pathname-default-type pathname "ttl")))
     (call-with-input-file pathname
       (lambda (port)
@@ -37,6 +37,7 @@ USA.
        (fluid-let ((*rdf-bnode-registry* (make-rdf-bnode-registry)))
          (post-process-parser-output
           (parse-turtle-doc (input-port->parser-buffer port))
+          registry
           (if (default-object? base-uri)
               (pathname->uri (merge-pathnames pathname))
               (merge-uris (file-namestring pathname)
@@ -446,13 +447,13 @@ USA.
 
 ;;; This code does prefix expansion and URI merging.
 
-(define (post-process-parser-output stmts base-uri)
+(define (post-process-parser-output stmts registry base-uri)
   (let ((prefixes
         (map (lambda (p)
                (let ((prefix (cadr p))
                      (v (uri->string (merge-uris (caddr p) base-uri))))
                  (if prefix
-                     (register-rdf-prefix (symbol prefix ':) v))
+                     (register-rdf-prefix (symbol prefix ':) v registry))
                  (cons prefix v)))
              (keep-matching-items stmts
                (lambda (stmt)
@@ -552,19 +553,19 @@ USA.
 \f
 ;;;; Encoder
 
-(define (write-rdf/turtle-file triples pathname)
+(define (write-rdf/turtle-file triples registry pathname)
   (call-with-output-file pathname
     (lambda (port)
       (port/set-coding port 'UTF-8)
-      (write-prefixes triples port)
-      (write-rdf/turtle-triples triples port))))
+      (write-rdf/turtle-prefixes triples registry port)
+      (write-rdf/turtle-triples triples registry port))))
 
-(define (write-prefixes triples port)
+(define (write-rdf/turtle-prefixes triples registry port)
   (let ((table (make-eq-hash-table)))
     (let ((check-obj
           (lambda (o)
             (if (uri? o)
-                (receive (prefix expansion) (uri->rdf-prefix o #f)
+                (receive (prefix expansion) (uri->rdf-prefix o registry #f)
                   (if (and prefix (not (hash-table/get table prefix #f)))
                       (hash-table/put! table prefix expansion)))))))
       (for-each (lambda (t)
@@ -589,14 +590,14 @@ USA.
   (write-string "> ." port)
   (newline port))
 
-(define (write-rdf/turtle-triples ts port)
+(define (write-rdf/turtle-triples triples registry port)
   (receive (uris bnodes)
-      (split-list ts (lambda (t) (uri? (rdf-triple-subject t))))
+      (split-list triples (lambda (t) (uri? (rdf-triple-subject t))))
     (receive (inline separate)
        (split-list bnodes
                    (lambda (t)
                      (= (let ((bnode (rdf-triple-subject t)))
-                          (count-matching-items ts
+                          (count-matching-items triples
                             (lambda (t)
                               (eq? (rdf-triple-object t) bnode))))
                         1)))
@@ -607,38 +608,39 @@ USA.
                   (lambda (ts)
                     (eq? (rdf-triple-subject (car ts)) bnode)))))))
        (for-each (lambda (ts)
-                   (write-top-level ts inline-bnode port))
+                   (write-top-level ts inline-bnode registry port))
                  (group-triples-by-subject uris))
        (for-each (lambda (ts)
-                   (write-top-level ts inline-bnode port))
+                   (write-top-level ts inline-bnode registry port))
                  (group-triples-by-subject separate))))))
 
 (define (group-triples-by-subject ts)
   (group-triples (sort-triples ts) rdf-triple-subject))
 \f
-(define (write-top-level ts inline-bnode port)
+(define (write-top-level ts inline-bnode registry port)
   (newline port)
   (let ((groups (group-triples ts rdf-triple-predicate))
        (indentation (indent+ 0)))
-    (write-rdf/turtle-subject (rdf-triple-subject (caar groups)) port)
+    (write-rdf/turtle-subject (rdf-triple-subject (caar groups)) registry port)
     (let ((writer
           (and (eq? (rdf-triple-predicate (caar groups)) rdf:type)
                (null? (cdar groups))
                (linear-object-writer (rdf-triple-object (caar groups))
-                                     inline-bnode))))
+                                     inline-bnode
+                                     registry))))
       (if writer
          (begin
            (space port)
-           (write-rdf/turtle-predicate rdf:type port)
+           (write-rdf/turtle-predicate rdf:type registry port)
            (space port)
            (writer port)
-           (write-pgroups-tail groups indentation inline-bnode port))
-         (write-pgroups groups indentation inline-bnode port))))
+           (write-pgroups-tail groups indentation inline-bnode registry port))
+         (write-pgroups groups indentation inline-bnode registry port))))
   (newline port)
   (write-string "." port)
   (newline port))
 
-(define (linear-object-writer o inline-bnode)
+(define (linear-object-writer o inline-bnode registry)
   (cond ((rdf-list->list o inline-bnode)
         => (lambda (objects)
              (cond ((null? objects)
@@ -646,7 +648,9 @@ USA.
                       (write-string "()" port)))
                    ((and (pair? objects)
                          (null? (cdr objects))
-                         (linear-object-writer (car objects) inline-bnode))
+                         (linear-object-writer (car objects)
+                                               inline-bnode
+                                               registry))
                     => (lambda (write-elt)
                          (lambda (port)
                            (write-string "(" port)
@@ -659,75 +663,79 @@ USA.
                (write-rdf/nt-bnode o port))))
        ((uri? o)
         (lambda (port)
-          (write-rdf/turtle-uri o port)))
+          (write-rdf/turtle-uri o registry port)))
        ((rdf-literal? o)
         (lambda (port)
-          (write-rdf/turtle-literal o port)))
+          (write-rdf/turtle-literal o registry port)))
        (else
         (error "Unknown RDF object:" o))))
 \f
-(define (write-pgroups groups indentation inline-bnode port)
-  (write-pgroup (car groups) indentation inline-bnode port)
-  (write-pgroups-tail groups indentation inline-bnode port))
+(define (write-pgroups groups indentation inline-bnode registry port)
+  (write-pgroup (car groups) indentation inline-bnode registry port)
+  (write-pgroups-tail groups indentation inline-bnode registry port))
 
-(define (write-pgroups-tail groups indentation inline-bnode port)
+(define (write-pgroups-tail groups indentation inline-bnode registry port)
   (for-each (lambda (ts)
              (write-string ";" port)
-             (write-pgroup ts indentation inline-bnode port))
+             (write-pgroup ts indentation inline-bnode registry port))
            (cdr groups)))
 
-(define (write-pgroup ts indentation inline-bnode port)
+(define (write-pgroup ts indentation inline-bnode registry port)
   (write-indentation indentation port)
   (let ((p (rdf-triple-predicate (car ts)))
        (os (map rdf-triple-object ts)))
-    (write-rdf/turtle-predicate p port)
+    (write-rdf/turtle-predicate p registry port)
     (let ((writer
           (and (null? (cdr os))
-               (linear-object-writer (car os) inline-bnode))))
+               (linear-object-writer (car os) inline-bnode registry))))
       (if writer
          (begin
            (space port)
            (writer port))
-         (write-ogroup os indentation inline-bnode port)))))
+         (write-ogroup os indentation inline-bnode registry port)))))
 
-(define (write-ogroup os indentation inline-bnode port)
+(define (write-ogroup os indentation inline-bnode registry port)
   (let ((indentation (indent+ indentation)))
-    (write-object (car os) indentation inline-bnode port)
+    (write-object (car os) indentation inline-bnode registry port)
     (for-each (lambda (o)
                (write-string "," port)
-               (write-object o indentation inline-bnode port))
+               (write-object o indentation inline-bnode registry port))
              (cdr os))))
 
-(define (write-object o indentation inline-bnode port)
+(define (write-object o indentation inline-bnode registry port)
   (write-indentation indentation port)
-  (cond ((linear-object-writer o inline-bnode)
+  (cond ((linear-object-writer o inline-bnode registry)
         => (lambda (writer)
              (writer port)))
        ((rdf-list->list o inline-bnode)
         => (lambda (os)
              (write-string "(" port)
-             (write-ogroup os indentation inline-bnode port)
+             (write-ogroup os indentation inline-bnode registry port)
              (write-indentation indentation port)
              (write-string ")" port)))
        (else
         (let ((groups
                (group-triples (inline-bnode o) rdf-triple-predicate)))
           (write-string "[" port)
-          (write-pgroups groups (indent+ indentation) inline-bnode port)
+          (write-pgroups groups
+                         (indent+ indentation)
+                         inline-bnode
+                         registry
+                         port)
           (write-indentation indentation port)
           (write-string "]" port)))))
 \f
-(define (write-rdf/turtle-subject s port)
-  (cond ((uri? s) (write-rdf/turtle-uri s port))
+(define (write-rdf/turtle-subject s registry port)
+  (cond ((uri? s) (write-rdf/turtle-uri s registry port))
        ((rdf-bnode? s) (write-rdf/nt-bnode s port))
        (else (error "Unknown RDF subject:" s))))
 
-(define (write-rdf/turtle-predicate p port)
+(define (write-rdf/turtle-predicate p registry port)
   (if (eq? p rdf:type)
       (write-string "a" port)
-      (write-rdf/turtle-uri p port)))
+      (write-rdf/turtle-uri p registry port)))
 
-(define (write-rdf/turtle-literal literal port)
+(define (write-rdf/turtle-literal literal registry port)
   (let ((text (rdf-literal-text literal)))
     (if (let ((type (rdf-literal-type literal)))
          (or (eq? type xsd:boolean)
@@ -740,7 +748,7 @@ USA.
          (cond ((rdf-literal-type literal)
                 => (lambda (uri)
                      (write-string "^^" port)
-                     (write-rdf/turtle-uri uri port)))
+                     (write-rdf/turtle-uri uri registry port)))
                ((rdf-literal-language literal)
                 => (lambda (lang)
                      (write-string "@" port)
@@ -762,8 +770,8 @@ USA.
        (write-string "\"\"\"" port))
       (write-rdf/nt-literal-text text port)))
 
-(define (write-rdf/turtle-uri uri port)
-  (let ((qname (uri->rdf-qname uri #f)))
+(define (write-rdf/turtle-uri uri registry port)
+  (let ((qname (uri->rdf-qname uri registry #f)))
     (if qname
        (write-string (symbol-name qname) port)
        (write-rdf/nt-uri uri port))))