guile-jsonld

serialize-rdf.scm

;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (jsonld serialize-rdf)
  #:use-module (ice-9 match)
  #:use-module (iri iri)
  #:use-module (jsonld deserialize-jsonld)
  #:use-module (jsonld json)
  #:use-module (jsonld object-to-rdf)
  #:use-module (jsonld rdf-to-object)
  #:use-module (json)
  #:use-module ((rdf rdf) #:hide (blank-node?))
  #:use-module ((rdf rdf) #:select (blank-node?) #:prefix rdf:)
  #:use-module (srfi srfi-1)
  #:export (serialize-rdf))

(define (uniq lst)
  (match lst
    (() '())
    ((element lst ...)
     (if (member element lst)
         (uniq lst)
         (cons element (uniq lst))))))

(define (jsonld-ref object spec)
  (match spec
    (() object)
    (((? string? key) spec ...)
     (jsonld-ref (assoc-ref object key) spec))
    (((? number? key) spec ...)
     (jsonld-ref (if (array? object) (array-ref object key) #f) spec))))

(define (jsonld-set object spec value)
  (match spec
    (() value)
    (((? string? key) spec ...)
     (alist-set object key (jsonld-set (assoc-ref object key) spec value)))
    (((? number? key) spec ...)
     (array-set! object (jsonld-set (array-ref object key) spec value) key)
     object)))

(define (convert-blank-nodes dataset)
  (define (node-convert-blank-nodes node)
    (if (rdf:blank-node? node)
        (string-append "_:b" (number->string node))
        node))

  (define (graph-convert-blank-nodes graph)
    (map
      (match-lambda
        (($ rdf-triple subject predicate object)
         (make-rdf-triple
           (node-convert-blank-nodes subject)
           (node-convert-blank-nodes predicate)
           (node-convert-blank-nodes object))))
      graph))

  (make-rdf-dataset
    (graph-convert-blank-nodes (rdf-dataset-default-graph dataset))
    (map
      (lambda (ng)
        (cons (car ng)
              (graph-convert-blank-nodes (cdr ng))))
      (rdf-dataset-named-graphs dataset))))

(define (single-element-array? object)
  (and (array? object) (not (string? object))
       (equal? (array-length object) 1)))

(define* (serialize-rdf dataset
                        #:key
                        ordered? rdf-direction use-native-types? use-rdf-type?
                        processing-mode)
  (set! dataset (convert-blank-nodes dataset))
  (set! dataset
    (make-rdf-dataset
      (uniq (rdf-dataset-default-graph dataset))
      (map
        (lambda (ng)
          (cons (car ng)
                (uniq (cdr ng))))
        (rdf-dataset-named-graphs dataset))))
  ;; 1
  (let ((default-graph '())
        ;; 2
        (graph-map `(("@default" . ())))
        ;; 3
        (referenced-once '())
        ;; 4
        (compound-literal-subjects '()))
    ;; 5
    (for-each-pair
      (lambda (name graph)
        ;; 5.2
        (unless (json-has-key? graph-map name)
          (set! graph-map (alist-set graph-map name '())))
        ;; 5.3
        (unless (json-has-key? compound-literal-subjects name)
          (set! compound-literal-subjects
            (alist-set compound-literal-subjects name '())))
        (set! default-graph (assoc-ref graph-map "@default"))
        ;; 5.4
        (unless (or (equal? name "@default")
                    (json-has-key? default-graph name))
          (set! default-graph (alist-set (assoc-ref graph-map "@default")
                                         name `(("@id" . ,name))))
          (set! graph-map (alist-set graph-map "@default" default-graph)))
        ;; 5.5
        (let ((node-map (assoc-ref graph-map name))
              ;; 5.6
              (compound-map (assoc-ref compound-literal-subjects name)))
          (for-each
            (match-lambda
              (($ rdf-triple subject predicate object)
               ;; 5.7.1
               (unless (json-has-key? node-map subject)
                 (set! node-map (alist-set node-map subject `(("@id" . ,subject)))))
                 ;; 5.7.2
               (let ((node-ref (list name subject))
                     (node (assoc-ref node-map subject))
                     (continue? #t))
                 ;; 5.7.3
                 (when (and (equal? rdf-direction "compound-literal")
                            (equal? predicate (rdf-iri "direction")))
                   (set! compound-map (alist-set compound-map subject #t)))
                 (when (or (absolute-iri? object) (blank-node? object))
                   ;; 5.7.4
                   (unless (json-has-key? node-map object)
                     (set! node-map (alist-set node-map object `(("@id" . ,object)))))
                   ;; 5.7.5
                   (when (and (equal? predicate (rdf-iri "type"))
                              (not use-rdf-type?))
                     (let* ((types (or (assoc-ref node "@type") #()))
                            (types (array->list types))
                            (types (if (member object types)
                                       types
                                       (append types (list object))))
                            (types (list->array 1 types)))
                       (set! node (alist-set node "@type" types))
                       (set! node-map (alist-set node-map subject node))
                       (set! continue? #f))))
                 ;; 5.7.6
                 (when continue?
                   (let* ((value (rdf-to-object object rdf-direction use-native-types?
                                                #:processing-mode
                                                processing-mode))
                          (value-ref (append node-ref (list predicate)))
                          ;; 5.7.7
                          (node-value (or (assoc-ref node predicate) #()))
                          (node-value (array->list node-value)))
                     ;; 5.7.8
                     (let loop ((nodes node-value) (num 0))
                       (match nodes
                         (()
                          (set! node-value (cons value node-value))
                          (set! value-ref (append value-ref (list num))))
                         ((n nodes ...)
                          (if (identical-json? value n)
                              (set! value-ref (append value-ref (list num)))
                              (loop nodes (1+ num))))))
                     ;; 5.7.7
                     (set! node (alist-set node predicate (list->array 1 node-value)))
                     (set! node-map (alist-set node-map subject node))
                     (cond
                        ;; 5.7.9
                       ((equal? object (rdf-iri "nil"))
                        (let* ((usages (or (assoc-ref (assoc-ref node-map object)
                                                      "usages")
                                           #()))
                               (usages (array->list usages)))
                          (set! usages
                            (append
                              usages
                              (list `(("node" . ,node-ref)
                                      ("property" . ,predicate)
                                      ("value" . ,value-ref)))))
                          (set! node-map
                            (jsonld-set
                              node-map (list object "usages")
                              (list->array 1 usages)))))
                       ;; 5.7.10
                       ((json-has-key? referenced-once object)
                        (set! referenced-once
                          (alist-set referenced-once object #f)))
                       ((blank-node? object)
                        (set! referenced-once
                          (alist-set referenced-once object
                                     `(("node" . ,node-ref)
                                       ("property" . ,predicate)
                                       ("value" . ,value-ref)))))))))))
            graph)
          (set! graph-map (alist-set graph-map name node-map))
          (set! compound-literal-subjects
            (alist-set compound-literal-subjects name compound-map))))
      (cons (cons "@default" (rdf-dataset-default-graph dataset))
            (rdf-dataset-named-graphs dataset)))
    (set! default-graph (assoc-ref graph-map "@default"))
    ;; 6
    (for-each-pair
      (lambda (name graph-object)
        ;; 6.1
        (when (list? (assoc-ref compound-literal-subjects name))
          (for-each-pair
            (lambda (cl _)
              ;; 6.1.1
              (let ((cl-entry (assoc-ref referenced-once cl)))
                (when (list? cl-entry)
                  ;; 6.1.2
                  (let* ((node-ref (assoc-ref cl-entry "node"))
                         (node (jsonld-ref graph-map node-ref))
                         ;; 6.1.3
                         (property (assoc-ref cl-entry "property"))
                         ;; 6.1.4
                         (value-ref (assoc-ref cl-entry "value"))
                         (value (jsonld-ref graph-map value-ref))
                         ;; 6.1.5
                         (cl-node (assoc-ref graph-object cl)))
                    (set! graph-object (alist-remove graph-object cl))
                    (when (equal? name "@default")
                      (set! default-graph graph-object))
                    (set! graph-map (alist-set graph-map name graph-object))
                    (when (list? cl-node)
                      ;; 6.1.6
                      (let* ((refs (array->list (assoc-ref node property))))
                        (set! refs
                          (map
                            (lambda (cl-reference)
                              (when (equal? (assoc-ref cl-reference "@id") cl)
                                ;; 6.1.6.1
                                (set! cl-reference (alist-remove cl-reference "@id"))
                                ;; 6.1.6.2
                                (let* ((value (assoc-ref cl-node (rdf-iri "value")))
                                       (value (array-ref value 0))
                                       (value (assoc-ref value "@value")))
                                  (set! cl-reference
                                    (alist-set cl-reference "@value" value)))
                                ;; 6.1.6.3
                                (let ((language (assoc-ref cl-node (rdf-iri "language"))))
                                  (when language
                                    (let* ((language (array-ref language 0))
                                           (language (assoc-ref language "@value")))
                                      (set! cl-reference
                                        (alist-set cl-reference "@language" language))
                                      (unless (well-formed-language-tag? language)
                                        (throw 'invalid-language-tagged-string language)))))
                                ;; 6.1.6.4
                                (let ((direction (assoc-ref cl-node (rdf-iri "direction"))))
                                  (when direction
                                    (let* ((direction (array-ref direction 0))
                                           (direction (assoc-ref direction "@value")))
                                      (set! cl-reference
                                        (alist-set cl-reference "@direction" direction))
                                      (unless (member direction '("ltr" "rtl"))
                                        (throw 'invalid-base-direction direction))))))
                              cl-reference)
                            refs))
                        (set! node (alist-set node property (list->array 1 refs))))
                      (set! graph-map (jsonld-set graph-map node-ref node)))))))
            (assoc-ref compound-literal-subjects name)))
        ;; 6.2
        (when (json-has-key? graph-object (rdf-iri "nil"))
          ;; 6.3
          (let* ((nil (assoc-ref graph-object (rdf-iri "nil")))
                 (usages (array->list (or (assoc-ref nil "usages") #()))))
            (set! usages
              (sort usages (lambda (a b)
                             (or (not (equal? (assoc-ref a "node") (assoc-ref b "node")))
                                 (and (equal? (assoc-ref a "property") (rdf-iri "first"))
                                      (equal? (assoc-ref b "property") (rdf-iri "rest")))))))
            ;; 6.4
            (for-each
              (lambda (usage)
                (let* ((node-ref (assoc-ref usage "node"))
                       (node (jsonld-ref graph-map node-ref))
                       (property (assoc-ref usage "property"))
                       (head-ref (assoc-ref usage "value"))
                       (head (jsonld-ref graph-map head-ref))
                       ;; 6.4.2
                       (lst '())
                       (list-nodes '()))
                  ;; 6.4.3
                  (let loop ()
                    (when (and (equal? property (rdf-iri "rest"))
                               (blank-node? (assoc-ref node "@id"))
                               (list? (assoc-ref referenced-once
                                                 (assoc-ref node "@id")))
                               (single-element-array? (assoc-ref node (rdf-iri "first")))
                               (single-element-array? (assoc-ref node (rdf-iri "rest")))
                               (null? (filter
                                        (lambda (e)
                                          (not (member (car e) 
                                                       (list (rdf-iri "first")
                                                             (rdf-iri "rest")
                                                             "@type"
                                                             "@id"))))
                                        node))
                               (or (not (json-has-key? node "@type"))
                                   (null?
                                     (filter
                                       (lambda (t)
                                         (not (equal? t (rdf-iri "List"))))
                                       (array->list (assoc-ref node "@type"))))))
                      ;; 6.4.3.1
                      (set! lst
                        (cons (array-ref (assoc-ref node (rdf-iri "first")) 0)
                              lst))
                      ;; 6.4.3.2
                      (set! list-nodes
                        (cons (assoc-ref node "@id") list-nodes))
                      ;; 6.4.3.3
                      (let ((node-usage (assoc-ref referenced-once
                                                   (assoc-ref node "@id"))))
                        ;; 6.4.3.4
                        (set! node-ref (assoc-ref node-usage "node"))
                        (set! node (jsonld-ref graph-map node-ref))
                        (set! property (assoc-ref node-usage "property"))
                        (set! head-ref (assoc-ref node-usage "value"))
                        (set! head (jsonld-ref graph-map head-ref))
                        (loop))))
                  ;; 6.4.4
                  (set! head (alist-remove head "@id"))
                  ;; 6.4.6
                  (set! head (alist-set head "@list" (list->array 1 lst)))
                  (set! graph-map (jsonld-set graph-map head-ref head))
                  ;; 6.4.7
                  (for-each
                    (lambda (node-id)
                      (set! graph-object (alist-remove graph-object node-id))
                      (when (equal? name "@default")
                        (set! default-graph graph-object))
                      (set! graph-map (alist-set graph-map name graph-object)))
                    list-nodes)))
              usages))))
      graph-map)
    (set! default-graph (assoc-ref graph-map "@default"))
    ;; 7
    (let ((result '()))
      ;; 8
      (for-each-pair
        (lambda (subject node)
          ;; 8.1
          (when (json-has-key? graph-map subject)
            (let ((new-graph '()))
              (for-each-pair
                (lambda (s n)
                  ;; 8.1.2
                  (unless (null? (filter
                                   (lambda (e)
                                     (not (member (car e) '("usages" "@id"))))
                                   n))
                    (set! new-graph
                      (append new-graph (list (alist-remove n "usages"))))))
                (if ordered?
                    (alist-sort-by-key (or (assoc-ref graph-map subject) '()))
                    (or (assoc-ref graph-map subject) '())))
              ;; 8.1.1
              (set! node (alist-set node "@graph" (list->array 1 new-graph)))))
          ;; 8.2
          (unless (null? (filter
                           (lambda (e)
                             (not (member (car e) '("usages" "@id"))))
                           node))
            (set! result
              (append result (list (alist-remove node "usages"))))))
        (if ordered?
            (alist-sort-by-key default-graph)
            default-graph))
      ;; 9
      (list->array 1 result))))


1	;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
2	;;;;
3	;;;; This library is free software; you can redistribute it and/or
4	;;;; modify it under the terms of the GNU Lesser General Public
5	;;;; License as published by the Free Software Foundation; either
6	;;;; version 3 of the License, or (at your option) any later version.
7	;;;;
8	;;;; This library is distributed in the hope that it will be useful,
9	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11	;;;; Lesser General Public License for more details.
12	;;;;
13	;;;; You should have received a copy of the GNU Lesser General Public
14	;;;; License along with this library; if not, write to the Free Software
15	;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
16	;;;;
17
18	(define-module (jsonld serialize-rdf)
19	#:use-module (ice-9 match)
20	#:use-module (iri iri)
21	#:use-module (jsonld deserialize-jsonld)
22	#:use-module (jsonld json)
23	#:use-module (jsonld object-to-rdf)
24	#:use-module (jsonld rdf-to-object)
25	#:use-module (json)
26	#:use-module ((rdf rdf) #:hide (blank-node?))
27	#:use-module ((rdf rdf) #:select (blank-node?) #:prefix rdf:)
28	#:use-module (srfi srfi-1)
29	#:export (serialize-rdf))
30
31	(define (uniq lst)
32	(match lst
33	(() '())
34	((element lst ...)
35	(if (member element lst)
36	(uniq lst)
37	(cons element (uniq lst))))))
38
39	(define (jsonld-ref object spec)
40	(match spec
41	(() object)
42	(((? string? key) spec ...)
43	(jsonld-ref (assoc-ref object key) spec))
44	(((? number? key) spec ...)
45	(jsonld-ref (if (array? object) (array-ref object key) #f) spec))))
46
47	(define (jsonld-set object spec value)
48	(match spec
49	(() value)
50	(((? string? key) spec ...)
51	(alist-set object key (jsonld-set (assoc-ref object key) spec value)))
52	(((? number? key) spec ...)
53	(array-set! object (jsonld-set (array-ref object key) spec value) key)
54	object)))
55
56	(define (convert-blank-nodes dataset)
57	(define (node-convert-blank-nodes node)
58	(if (rdf:blank-node? node)
59	(string-append "_:b" (number->string node))
60	node))
61
62	(define (graph-convert-blank-nodes graph)
63	(map
64	(match-lambda
65	(($ rdf-triple subject predicate object)
66	(make-rdf-triple
67	(node-convert-blank-nodes subject)
68	(node-convert-blank-nodes predicate)
69	(node-convert-blank-nodes object))))
70	graph))
71
72	(make-rdf-dataset
73	(graph-convert-blank-nodes (rdf-dataset-default-graph dataset))
74	(map
75	(lambda (ng)
76	(cons (car ng)
77	(graph-convert-blank-nodes (cdr ng))))
78	(rdf-dataset-named-graphs dataset))))
79
80	(define (single-element-array? object)
81	(and (array? object) (not (string? object))
82	(equal? (array-length object) 1)))
83
84	(define* (serialize-rdf dataset
85	#:key
86	ordered? rdf-direction use-native-types? use-rdf-type?
87	processing-mode)
88	(set! dataset (convert-blank-nodes dataset))
89	(set! dataset
90	(make-rdf-dataset
91	(uniq (rdf-dataset-default-graph dataset))
92	(map
93	(lambda (ng)
94	(cons (car ng)
95	(uniq (cdr ng))))
96	(rdf-dataset-named-graphs dataset))))
97	;; 1
98	(let ((default-graph '())
99	;; 2
100	(graph-map `(("@default" . ())))
101	;; 3
102	(referenced-once '())
103	;; 4
104	(compound-literal-subjects '()))
105	;; 5
106	(for-each-pair
107	(lambda (name graph)
108	;; 5.2
109	(unless (json-has-key? graph-map name)
110	(set! graph-map (alist-set graph-map name '())))
111	;; 5.3
112	(unless (json-has-key? compound-literal-subjects name)
113	(set! compound-literal-subjects
114	(alist-set compound-literal-subjects name '())))
115	(set! default-graph (assoc-ref graph-map "@default"))
116	;; 5.4
117	(unless (or (equal? name "@default")
118	(json-has-key? default-graph name))
119	(set! default-graph (alist-set (assoc-ref graph-map "@default")
120	name `(("@id" . ,name))))
121	(set! graph-map (alist-set graph-map "@default" default-graph)))
122	;; 5.5
123	(let ((node-map (assoc-ref graph-map name))
124	;; 5.6
125	(compound-map (assoc-ref compound-literal-subjects name)))
126	(for-each
127	(match-lambda
128	(($ rdf-triple subject predicate object)
129	;; 5.7.1
130	(unless (json-has-key? node-map subject)
131	(set! node-map (alist-set node-map subject `(("@id" . ,subject)))))
132	;; 5.7.2
133	(let ((node-ref (list name subject))
134	(node (assoc-ref node-map subject))
135	(continue? #t))
136	;; 5.7.3
137	(when (and (equal? rdf-direction "compound-literal")
138	(equal? predicate (rdf-iri "direction")))
139	(set! compound-map (alist-set compound-map subject #t)))
140	(when (or (absolute-iri? object) (blank-node? object))
141	;; 5.7.4
142	(unless (json-has-key? node-map object)
143	(set! node-map (alist-set node-map object `(("@id" . ,object)))))
144	;; 5.7.5
145	(when (and (equal? predicate (rdf-iri "type"))
146	(not use-rdf-type?))
147	(let* ((types (or (assoc-ref node "@type") #()))
148	(types (array->list types))
149	(types (if (member object types)
150	types
151	(append types (list object))))
152	(types (list->array 1 types)))
153	(set! node (alist-set node "@type" types))
154	(set! node-map (alist-set node-map subject node))
155	(set! continue? #f))))
156	;; 5.7.6
157	(when continue?
158	(let* ((value (rdf-to-object object rdf-direction use-native-types?
159	#:processing-mode
160	processing-mode))
161	(value-ref (append node-ref (list predicate)))
162	;; 5.7.7
163	(node-value (or (assoc-ref node predicate) #()))
164	(node-value (array->list node-value)))
165	;; 5.7.8
166	(let loop ((nodes node-value) (num 0))
167	(match nodes
168	(()
169	(set! node-value (cons value node-value))
170	(set! value-ref (append value-ref (list num))))
171	((n nodes ...)
172	(if (identical-json? value n)
173	(set! value-ref (append value-ref (list num)))
174	(loop nodes (1+ num))))))
175	;; 5.7.7
176	(set! node (alist-set node predicate (list->array 1 node-value)))
177	(set! node-map (alist-set node-map subject node))
178	(cond
179	;; 5.7.9
180	((equal? object (rdf-iri "nil"))
181	(let* ((usages (or (assoc-ref (assoc-ref node-map object)
182	"usages")
183	#()))
184	(usages (array->list usages)))
185	(set! usages
186	(append
187	usages
188	(list `(("node" . ,node-ref)
189	("property" . ,predicate)
190	("value" . ,value-ref)))))
191	(set! node-map
192	(jsonld-set
193	node-map (list object "usages")
194	(list->array 1 usages)))))
195	;; 5.7.10
196	((json-has-key? referenced-once object)
197	(set! referenced-once
198	(alist-set referenced-once object #f)))
199	((blank-node? object)
200	(set! referenced-once
201	(alist-set referenced-once object
202	`(("node" . ,node-ref)
203	("property" . ,predicate)
204	("value" . ,value-ref)))))))))))
205	graph)
206	(set! graph-map (alist-set graph-map name node-map))
207	(set! compound-literal-subjects
208	(alist-set compound-literal-subjects name compound-map))))
209	(cons (cons "@default" (rdf-dataset-default-graph dataset))
210	(rdf-dataset-named-graphs dataset)))
211	(set! default-graph (assoc-ref graph-map "@default"))
212	;; 6
213	(for-each-pair
214	(lambda (name graph-object)
215	;; 6.1
216	(when (list? (assoc-ref compound-literal-subjects name))
217	(for-each-pair
218	(lambda (cl _)
219	;; 6.1.1
220	(let ((cl-entry (assoc-ref referenced-once cl)))
221	(when (list? cl-entry)
222	;; 6.1.2
223	(let* ((node-ref (assoc-ref cl-entry "node"))
224	(node (jsonld-ref graph-map node-ref))
225	;; 6.1.3
226	(property (assoc-ref cl-entry "property"))
227	;; 6.1.4
228	(value-ref (assoc-ref cl-entry "value"))
229	(value (jsonld-ref graph-map value-ref))
230	;; 6.1.5
231	(cl-node (assoc-ref graph-object cl)))
232	(set! graph-object (alist-remove graph-object cl))
233	(when (equal? name "@default")
234	(set! default-graph graph-object))
235	(set! graph-map (alist-set graph-map name graph-object))
236	(when (list? cl-node)
237	;; 6.1.6
238	(let* ((refs (array->list (assoc-ref node property))))
239	(set! refs
240	(map
241	(lambda (cl-reference)
242	(when (equal? (assoc-ref cl-reference "@id") cl)
243	;; 6.1.6.1
244	(set! cl-reference (alist-remove cl-reference "@id"))
245	;; 6.1.6.2
246	(let* ((value (assoc-ref cl-node (rdf-iri "value")))
247	(value (array-ref value 0))
248	(value (assoc-ref value "@value")))
249	(set! cl-reference
250	(alist-set cl-reference "@value" value)))
251	;; 6.1.6.3
252	(let ((language (assoc-ref cl-node (rdf-iri "language"))))
253	(when language
254	(let* ((language (array-ref language 0))
255	(language (assoc-ref language "@value")))
256	(set! cl-reference
257	(alist-set cl-reference "@language" language))
258	(unless (well-formed-language-tag? language)
259	(throw 'invalid-language-tagged-string language)))))
260	;; 6.1.6.4
261	(let ((direction (assoc-ref cl-node (rdf-iri "direction"))))
262	(when direction
263	(let* ((direction (array-ref direction 0))
264	(direction (assoc-ref direction "@value")))
265	(set! cl-reference
266	(alist-set cl-reference "@direction" direction))
267	(unless (member direction '("ltr" "rtl"))
268	(throw 'invalid-base-direction direction))))))
269	cl-reference)
270	refs))
271	(set! node (alist-set node property (list->array 1 refs))))
272	(set! graph-map (jsonld-set graph-map node-ref node)))))))
273	(assoc-ref compound-literal-subjects name)))
274	;; 6.2
275	(when (json-has-key? graph-object (rdf-iri "nil"))
276	;; 6.3
277	(let* ((nil (assoc-ref graph-object (rdf-iri "nil")))
278	(usages (array->list (or (assoc-ref nil "usages") #()))))
279	(set! usages
280	(sort usages (lambda (a b)
281	(or (not (equal? (assoc-ref a "node") (assoc-ref b "node")))
282	(and (equal? (assoc-ref a "property") (rdf-iri "first"))
283	(equal? (assoc-ref b "property") (rdf-iri "rest")))))))
284	;; 6.4
285	(for-each
286	(lambda (usage)
287	(let* ((node-ref (assoc-ref usage "node"))
288	(node (jsonld-ref graph-map node-ref))
289	(property (assoc-ref usage "property"))
290	(head-ref (assoc-ref usage "value"))
291	(head (jsonld-ref graph-map head-ref))
292	;; 6.4.2
293	(lst '())
294	(list-nodes '()))
295	;; 6.4.3
296	(let loop ()
297	(when (and (equal? property (rdf-iri "rest"))
298	(blank-node? (assoc-ref node "@id"))
299	(list? (assoc-ref referenced-once
300	(assoc-ref node "@id")))
301	(single-element-array? (assoc-ref node (rdf-iri "first")))
302	(single-element-array? (assoc-ref node (rdf-iri "rest")))
303	(null? (filter
304	(lambda (e)
305	(not (member (car e)
306	(list (rdf-iri "first")
307	(rdf-iri "rest")
308	"@type"
309	"@id"))))
310	node))
311	(or (not (json-has-key? node "@type"))
312	(null?
313	(filter
314	(lambda (t)
315	(not (equal? t (rdf-iri "List"))))
316	(array->list (assoc-ref node "@type"))))))
317	;; 6.4.3.1
318	(set! lst
319	(cons (array-ref (assoc-ref node (rdf-iri "first")) 0)
320	lst))
321	;; 6.4.3.2
322	(set! list-nodes
323	(cons (assoc-ref node "@id") list-nodes))
324	;; 6.4.3.3
325	(let ((node-usage (assoc-ref referenced-once
326	(assoc-ref node "@id"))))
327	;; 6.4.3.4
328	(set! node-ref (assoc-ref node-usage "node"))
329	(set! node (jsonld-ref graph-map node-ref))
330	(set! property (assoc-ref node-usage "property"))
331	(set! head-ref (assoc-ref node-usage "value"))
332	(set! head (jsonld-ref graph-map head-ref))
333	(loop))))
334	;; 6.4.4
335	(set! head (alist-remove head "@id"))
336	;; 6.4.6
337	(set! head (alist-set head "@list" (list->array 1 lst)))
338	(set! graph-map (jsonld-set graph-map head-ref head))
339	;; 6.4.7
340	(for-each
341	(lambda (node-id)
342	(set! graph-object (alist-remove graph-object node-id))
343	(when (equal? name "@default")
344	(set! default-graph graph-object))
345	(set! graph-map (alist-set graph-map name graph-object)))
346	list-nodes)))
347	usages))))
348	graph-map)
349	(set! default-graph (assoc-ref graph-map "@default"))
350	;; 7
351	(let ((result '()))
352	;; 8
353	(for-each-pair
354	(lambda (subject node)
355	;; 8.1
356	(when (json-has-key? graph-map subject)
357	(let ((new-graph '()))
358	(for-each-pair
359	(lambda (s n)
360	;; 8.1.2
361	(unless (null? (filter
362	(lambda (e)
363	(not (member (car e) '("usages" "@id"))))
364	n))
365	(set! new-graph
366	(append new-graph (list (alist-remove n "usages"))))))
367	(if ordered?
368	(alist-sort-by-key (or (assoc-ref graph-map subject) '()))
369	(or (assoc-ref graph-map subject) '())))
370	;; 8.1.1
371	(set! node (alist-set node "@graph" (list->array 1 new-graph)))))
372	;; 8.2
373	(unless (null? (filter
374	(lambda (e)
375	(not (member (car e) '("usages" "@id"))))
376	node))
377	(set! result
378	(append result (list (alist-remove node "usages"))))))
379	(if ordered?
380	(alist-sort-by-key default-graph)
381	default-graph))
382	;; 9
383	(list->array 1 result))))
384