From 8fa8726306be1accd1d6a1eb4d03887d1ca41b4f Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 29 Oct 2006 05:32:35 +0000 Subject: [PATCH] Change all Turtle procedures to require a prefix-registry argument. --- v7/src/xml/turtle.scm | 104 +++++++++++++++++++++++------------------- 1 file changed, 56 insertions(+), 48 deletions(-) diff --git a/v7/src/xml/turtle.scm b/v7/src/xml/turtle.scm index d27ade602..4918d6122 100644 --- 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. ;;;; 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. ;;;; 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)) -(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)))) -(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))))) -(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)))) -- 2.25.1