guile-jsonld

compaction.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 compaction)
  #:use-module (jsonld context)
  #:use-module (jsonld context-processing)
  #:use-module (jsonld inverse-context-creation)
  #:use-module (jsonld iri-compaction)
  #:use-module (jsonld iri-expansion)
  #:use-module (jsonld json)
  #:use-module (jsonld value-compaction)
  #:export (compaction))

(define-syntax update-result
  (syntax-rules ()
    ((_ result nest-term nest-result)
     (set! result
       (if nest-term
           (alist-set result nest-term nest-result)
           nest-result)))))

(define (add-value object key value as-array?)
  (let* ((value (if (json-array? value)
                    (array->list value)
                    (list value)))
         (original (if (json-has-key? object key)
                       (assoc-ref object key)
                       #()))
         (original (if (json-array? original)
                       (array->list original)
                       (list original)))
         (new-value (append original value))
         (new-value
           (if (and (= (length new-value) 1) (not as-array?))
               (car new-value)
               (list->array 1 new-value))))
    (alist-set object key new-value)))

(define* (compaction active-context inverse-context active-property element
                     #:key (compact-arrays? #f) (ordered? #f) processing-mode)
  ;; 1
  (let ((type-scoped-context active-context)
        (def (term-definition-ref active-context active-property)))
    (cond
      ;; 2
      ((scalar? element)
       element)
      ;; 3
      ((json-array? element)
       ;; 3.1
       (let ((result '()))
         ;; 3.2
         (for-each
           (lambda (item)
             ;; 3.2.1
             (let ((compacted-item (compaction active-context inverse-context
                                               active-property item
                                               #:compact-arrays? compact-arrays?
                                               #:ordered? ordered?
                                               #:processing-mode processing-mode)))
               ;; 3.2.2
               (unless (equal? compacted-item #nil)
                 (set! result (cons compacted-item result)))))
           (array->list element))
         (set! result (reverse result))
         (if (let ((container-mapping
                     (container-mapping active-context active-property)))
               (or (not (= (length result) 1))
                   (equal? compact-arrays? #f)
                   (equal? active-property "@graph")
                   (equal? active-property "@set")
                   (member "@set" container-mapping)
                   (member "@list" container-mapping)))
             ;; 3.3
             (list->array 1 result)
             ;; 3.4
             (car result))))
      ;; 4
      (else
        ;; 5
        (when (active-context-previous active-context)
          (unless (or (json-has-key? element "@value")
                      (and (json-has-key? element "@id")
                           (null? (filter (lambda (kp) (not (equal? (car kp) "@id")))
                                          element))))
            (set! active-context (active-context-previous active-context))
            (set! inverse-context (inverse-context-creation active-context))))
        ;; 6
        (when (and def (term-definition-context def))
          ;; 6.1
          (set! active-context
            (context-processing active-context (term-definition-context def)
                                (term-definition-base-url def)
                                #:override-protected? #t))
          ;; 6.2
          (set! inverse-context (inverse-context-creation active-context)))
        ;; 7
        (cond
          ((and (or (json-has-key? element "@value")
                    (json-has-key? element "@id"))
                (let ((compact
                      (value-compaction active-context inverse-context
                                        active-property element processing-mode)))
                  (or (scalar? compact)
                      (and def (equal? (term-definition-type def) "@json")))))
           (value-compaction active-context inverse-context active-property
                             element processing-mode))
          ;; 8
          ((and (json-has-key? element "@list")
                (member "@list" (container-mapping active-context active-property)))
           (compaction active-context inverse-context active-property
                       (assoc-ref element "@list")
                       #:compact-arrays? compact-arrays?
                       #:ordered? ordered?))
          ;; 9 and 10
          (else
            (let ((inside-reverse? (equal? active-property "@reverse"))
                  (result '()))
              ;; 11
              (when (json-has-key? element "@type")
                (let* ((types (assoc-ref element "@type"))
                       (types (if (json-array? types)
                                  (array->list types)
                                  (list types)))
                       (compacted-types
                         (map
                           (lambda (type)
                             (iri-compaction active-context inverse-context type
                                             #:vocab? #t #:processing-mode processing-mode))
                           types)))
                  (for-each
                    (lambda (term)
                      ;; 11.1
                      (when (and
                              (term-definition-ref type-scoped-context term)
                              (term-definition-context
                                (term-definition-ref type-scoped-context term)))
                        ;; 11.1.1
                        (set! active-context
                          (context-processing
                            active-context
                            (term-definition-context
                              (term-definition-ref type-scoped-context term))
                            (term-definition-base-url
                              (term-definition-ref type-scoped-context term))
                            #:propagate? #f))
                        ;; 11.1.2
                        (set! inverse-context
                          (inverse-context-creation active-context))))
                    (sort compacted-types string<=?))))
              ;; 12
              (for-each-pair
                (lambda (expanded-property expanded-value)
                  (set! result
                    (step-12 active-context inverse-context expanded-property
                             expanded-value result compact-arrays? ordered?
                             inside-reverse? type-scoped-context active-property
                             processing-mode)))
                (if ordered?
                    (alist-sort-by-key element)
                    element))
              ;; 13
              result)))))))

(define (step-12 active-context inverse-context expanded-property expanded-value
                 result compact-arrays? ordered? inside-reverse? type-scoped-context
                 active-property processing-mode)
  (cond
    ;; 12.1
    ((equal? expanded-property "@id")
     ;; XXX: not clear what to do if expanded-value is not a
     ;; string, make sure there is a test
     (let ((compacted-value
             (if (string? expanded-value)
                 (iri-compaction active-context inverse-context expanded-value
                                 #:vocab? #f #:processing-mode processing-mode)
                 expanded-value))
           (alias (iri-compaction active-context inverse-context expanded-property
                                  #:vocab? #t #:processing-mode processing-mode)))
       (set! result
         (alist-set result alias compacted-value))))
    ;; 12.2
    ((equal? expanded-property "@type")
     (let* ((compacted-value #f)
            (alias (iri-compaction active-context inverse-context expanded-property
                                   #:vocab? #t #:processing-mode processing-mode))
            (as-array?
              (or 
                (and
                  (not (processing-mode-1.0? processing-mode))
                  (member "@set" (container-mapping active-context alias)))
                (not compact-arrays?)))
            (type-scoped-inverse-context
              (inverse-context-creation type-scoped-context)))
       (if (string? expanded-value)
           (set! compacted-value
             (iri-compaction type-scoped-context type-scoped-inverse-context
                             expanded-value
                             #:vocab? #t #:processing-mode processing-mode))
           (begin
             (set! expanded-value (array->list expanded-value))
             (set! compacted-value
               (list->array 1
                 (map
                   (lambda (v)
                     (iri-compaction type-scoped-context type-scoped-inverse-context
                                     v
                                     #:vocab? #t #:processing-mode processing-mode))
                   expanded-value)))))
       (when (and (json-array? compacted-value) (= (array-length compacted-value) 1))
         (set! compacted-value (car (array->list compacted-value))))
       (set! result
         (add-value result alias compacted-value as-array?))))
    ;; 12.3
    ((equal? expanded-property "@reverse")
     (let ((compacted-value
             (compaction active-context inverse-context "@reverse" expanded-value
                         #:compact-arrays? compact-arrays? #:ordered? ordered?)))
       ;; 12.3.2
       (for-each-pair
         (lambda (property value)
           (let ((def (term-definition-ref active-context property)))
             (when (and def (term-definition-reverse? def))
               (let ((as-array? (or
                                  (member "@set"
                                          (container-mapping active-context property))
                                  (not compact-arrays?))))
                 (set! result
                   (add-value result property value as-array?)))
               (set! compacted-value
                 (alist-remove compacted-value property)))))
         compacted-value)
       ;; 12.3.3
       (unless (null? compacted-value)
         (let ((alias (iri-compaction active-context inverse-context "@reverse"
                                      #:vocab? #t #:processing-mode processing-mode)))
           (set! result (alist-set result alias compacted-value))))))
    ;; 12.4
    ((equal? expanded-property "@preserve")
     (let ((compacted-value
             (compaction active-context inverse-context active-property
                         expanded-value #:compact-arrays? compact-arrays?
                         #:ordered? ordered?)))
       (unless (equal? expanded-value #())
         (set! result (alist-set result "@preserve" compacted-value)))))
    ;; 12.5
    ((and (equal? expanded-property "@index")
          (member "@index"
                  (container-mapping active-context active-property)))
     #t)
    ;; 12.6
    ((or (equal? expanded-property "@direction")
         (equal? expanded-property "@index")
         (equal? expanded-property "@language")
         (equal? expanded-property "@value"))
      (let ((alias (iri-compaction active-context inverse-context expanded-property
                                   #:vocab? #t #:processing-mode processing-mode)))
        (set! result
          (alist-set result alias expanded-value))))
    (else
      ;; 12.7
      (when (equal? expanded-value #())
        (let* ((item-active-property
                 (iri-compaction active-context inverse-context expanded-property
                                 #:value expanded-value
                                 #:vocab? #t
                                 #:reverse? inside-reverse?
                                 #:processing-mode processing-mode))
               (def (term-definition-ref active-context
                                         item-active-property))
               (nest-term (if def (term-definition-nest def) #f))
               ;; 12.7.4
               (nest-result result))
          ;; 12.7.2
          (when nest-term
            (unless (or (equal? nest-term "@nest")
                        (equal? (expand-key active-context nest-term)
                                "@nest"))
              (throw 'invalid-@nest-value))
            (set! nest-result
              (if (json-has-key? result nest-term)
                  (assoc-ref result nest-term)
                  '())))
          ;; 12.7.4
          (set! nest-result
            (add-value nest-result item-active-property #() #t))
          (update-result result nest-term nest-result)))
      ;; 12.8
      (for-each
        (lambda (expanded-item)
          (let* ((item-active-property
                   (iri-compaction
                     active-context inverse-context expanded-property
                     #:value expanded-item
                     #:vocab? #t
                     #:reverse? inside-reverse?
                     #:processing-mode processing-mode))
                 (def (term-definition-ref active-context item-active-property))
                 (nest-term (if def (term-definition-nest def) #f))
                 ;; 12.8.3
                 (nest-result result)
                 ;; 12.8.4
                 (container (container-mapping active-context item-active-property))
                 ;; 12.8.5
                 (as-array? (or (member "@set" container)
                                (equal? item-active-property "@list")
                                (equal? item-active-property "@graph")
                                (not compact-arrays?)))
                 ;; 12.8.6
                 (compacted-item
                   (compaction active-context inverse-context item-active-property
                               (if (json-has-key? expanded-item 
                                                  "@list")
                                   (assoc-ref expanded-item "@list")
                                   (if (graph-object? expanded-item)
                                       (assoc-ref expanded-item "@graph")
                                       expanded-item))
                               #:compact-arrays? compact-arrays?
                               #:ordered? ordered?)))
            ;; 12.8.2
            (when nest-term
              (unless (or (equal? nest-term "@nest")
                          (equal? (expand-key active-context nest-term) "@nest"))
                (throw 'invalid-@nest-value))
              (set! nest-result
                (if (json-has-key? result nest-term)
                    (assoc-ref result nest-term)
                    '())))
            (cond
              ;; 12.8.7
              ((json-has-key? expanded-item "@list")
               ;; 12.8.7.1
               (unless (json-array? compacted-item)
                 (set! compacted-item `#(,compacted-item)))
               (if (member "@list" container)
                 ;; 12.8.7.3
                 (set! nest-result
                   (alist-set nest-result item-active-property compacted-item))
                 ;; 12.8.7.2
                 (begin
                   (set! compacted-item
                     `((,(iri-compaction active-context inverse-context
                                         "@list" #:vocab? #t
                                         #:processing-mode processing-mode) .
                         ,compacted-item)))
                   (when (json-has-key? expanded-item "@index")
                     (set! compacted-item
                       (alist-set
                         compacted-item
                         (iri-compaction active-context inverse-context
                                         "@index" #:vocab? #t
                                         #:processing-mode processing-mode)
                         (assoc-ref expanded-item "@index"))))
                   (set! nest-result
                     (add-value nest-result item-active-property compacted-item
                                as-array?))))
               (update-result result nest-term nest-result))
              ;; 12.8.8
              ((graph-object? expanded-item)
               (cond
                 ;; 12.8.8.1
                 ((and (member "@id" container)
                       (member "@graph" container))
                  (let* ((map-object
                           (or (assoc-ref nest-result item-active-property) '()))
                         (map-key
                           (if (json-has-key? expanded-item "@id")
                               (assoc-ref expanded-item "@id")
                               "@none"))
                         (map-key
                           (iri-compaction
                             active-context inverse-context map-key
                             #:vocab? (not (json-has-key? expanded-item "@id"))
                             #:processing-mode processing-mode)))
                    ;; 12.8.8.1.3
                    (set! map-object
                      (add-value map-object map-key compacted-item as-array?))
                    (set! nest-result
                      (alist-set nest-result item-active-property map-object))
                    (update-result result nest-term nest-result)))
                 ;; 12.8.8.2
                 ((and (member "@graph" container)
                       (member "@index" container)
                       (simple-graph-object? expanded-item))
                  (let ((map-object
                          (or (assoc-ref nest-result item-active-property) '()))
                        (map-key
                          (if (json-has-key? expanded-item "@index")
                              (assoc-ref expanded-item "@index")
                              "@none")))
                    ;; 12.8.8.2.3
                    (set! map-object
                      (add-value map-object map-key compacted-item as-array?))
                    (set! nest-result
                      (alist-set nest-result item-active-property map-object))
                    (update-result result nest-term nest-result)))
                 ;; 12.8.8.3
                 ((and (member "@graph" container)
                       (simple-graph-object? expanded-item))
                  (when (and (json-array? compacted-item)
                             (> (array-length compacted-item) 1))
                    (set! compacted-item
                      `((,(iri-compaction active-context inverse-context "@included"
                                          #:vocab? #t #:processing-mode processing-mode) .
                         ,compacted-item))))
                  (set! nest-result
                    (add-value nest-result item-active-property compacted-item
                               as-array?))
                  (update-result result nest-term nest-result))
                 ;; 12.8.8.4
                 (else
                   ;; 12.8.8.4.1
                   (set! compacted-item
                     `((,(iri-compaction active-context inverse-context "@graph"
                                         #:vocab? #t #:processing-mode processing-mode) .
                        ,compacted-item)))
                   ;; 12.8.8.4.2
                   (when (json-has-key? expanded-item "@id")
                     (set! compacted-item
                       (alist-set
                         compacted-item
                         (iri-compaction active-context inverse-context "@id"
                                         #:vocab? #t
                                         #:processing-mode processing-mode)
                         (iri-compaction active-context inverse-context
                                         (assoc-ref expanded-item "@id")
                                         #:vocab? #f
                                         #:processing-mode processing-mode))))
                   ;; 12.8.8.4.3
                   (when (json-has-key? expanded-item "@index")
                     (set! compacted-item
                       (alist-set
                         compacted-item
                         (iri-compaction active-context inverse-context "@index"
                                         #:vocab? #t
                                         #:processing-mode processing-mode)
                         (assoc-ref expanded-item "@index"))))
                   ;; 12.8.8.4.4
                   (set! nest-result
                     (add-value nest-result item-active-property compacted-item
                                as-array?))
                   (update-result result nest-term nest-result))))
              ;; 12.8.9
              ((and (not (member "@graph" container))
                    (or (member "@language" container)
                        (member "@index" container)
                        (member "@id" container)
                        (member "@type" container)))
               ;; 12.8.9.1
               (let* ((map-object (or (assoc-ref nest-result item-active-property)
                                      '()))
                      ;; 12.8.9.2
                      (container-key (iri-compaction active-context inverse-context
                                                     (cond
                                                       ((member "@language" container) "@language")
                                                       ((member "@index" container) "@index")
                                                       ((member "@id" container) "@id")
                                                       (else "@type"))
                                                     #:vocab? #t))
                      (map-key #nil)
                      ;; 12.8.9.3
                      (def (term-definition-ref active-context item-active-property))
                      (index-key (or (and def (term-definition-index def)) "@index")))
                 (cond
                   ;; 12.8.9.4
                   ((and (member "@language" container)
                             (json-has-key? expanded-item "@value"))
                    (set! compacted-item (assoc-ref expanded-item "@value"))
                    (when (json-has-key? expanded-item "@language")
                      (set! map-key (assoc-ref expanded-item "@language"))))
                   ;; 12.8.9.5
                   ((and (member "@index" container)
                         (equal? index-key "@index"))
                    (when (json-has-key? expanded-item "@index")
                      (set! map-key (assoc-ref expanded-item "@index"))))
                   ;; 12.8.9.6
                   ((member "@index" container)
                    ;; 12.8.9.6.1
                    (set! container-key
                      (iri-compaction active-context inverse-context index-key
                                      #:vocab? #t))
                    ;; 12.8.9.6.2
                    (let* ((keys (assoc-ref compacted-item container-key))
                           (keys (if (json-array? keys)
                                     (array->list keys)
                                     (list keys)))
                           (key (and (not (null? keys)) (car keys)))
                           (remaining (if key (cdr keys) '())))
                      (when key
                        (unless (string? key)
                          (set! remaining keys)
                          (set! key #f))
                        (when key
                          (set! map-key key)))
                      ;; 12.8.9.6.3
                      (if (null? remaining)
                          (when (json-has-key? compacted-item container-key)
                            (set! compacted-item
                              (alist-remove compacted-item container-key)))
                          (set! compacted-item
                            (alist-set compacted-item container-key
                                       (if (= (length remaining) 1)
                                           (car remaining)
                                           (list->array 1 remaining)))))))
                   ;; 12.8.9.7
                   ((member "@id" container)
                    (when (json-has-key? compacted-item container-key)
                      (set! map-key (assoc-ref compacted-item container-key))
                      (set! compacted-item (alist-remove compacted-item container-key))))
                   ;; 12.8.9.8
                   ((member "@type" container)
                    (let* ((keys (assoc-ref compacted-item container-key))
                           (keys (if (json-array? keys)
                                     (array->list keys)
                                     (list keys)))
                           (key (and (not (null? keys)) (car keys)))
                           (remaining (if key (cdr keys) '())))
                      ;; 12.8.9.8.1
                      (when key
                        (set! map-key key))
                      ;; 12.8.9.8.2
                      (if (null? remaining)
                          (set! compacted-item
                            (alist-remove compacted-item container-key))
                          (set! compacted-item
                            (alist-set compacted-item container-key
                                       (if (= (length remaining) 1)
                                           (car remaining)
                                           (list->array 1 remaining)))))
                      (when (and (= (length compacted-item) 1)
                                 (equal?
                                   (expand-key active-context (car (car compacted-item)))
                                   "@id"))
                        (set! compacted-item
                          (compaction
                            active-context inverse-context item-active-property
                            `(("@id" . ,(assoc-ref expanded-item "@id")))))))))
                 ;; 12.8.9.9
                 (when (equal? map-key #nil)
                   (set! map-key (iri-compaction active-context inverse-context
                                                 "@none" #:vocab? #t)))
                 ;; 12.8.9.10
                 (set! map-object
                   (add-value map-object map-key compacted-item as-array?))
                 (set! nest-result
                   (alist-set nest-result item-active-property map-object))
                 (update-result result nest-term nest-result)))
              ;; 12.8.10
              (else
                (set! nest-result
                  (add-value nest-result item-active-property
                             compacted-item as-array?))
                (update-result result nest-term nest-result)))))
        (array->list expanded-value))))
  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 compaction)
19	#:use-module (jsonld context)
20	#:use-module (jsonld context-processing)
21	#:use-module (jsonld inverse-context-creation)
22	#:use-module (jsonld iri-compaction)
23	#:use-module (jsonld iri-expansion)
24	#:use-module (jsonld json)
25	#:use-module (jsonld value-compaction)
26	#:export (compaction))
27
28	(define-syntax update-result
29	(syntax-rules ()
30	((_ result nest-term nest-result)
31	(set! result
32	(if nest-term
33	(alist-set result nest-term nest-result)
34	nest-result)))))
35
36	(define (add-value object key value as-array?)
37	(let* ((value (if (json-array? value)
38	(array->list value)
39	(list value)))
40	(original (if (json-has-key? object key)
41	(assoc-ref object key)
42	#()))
43	(original (if (json-array? original)
44	(array->list original)
45	(list original)))
46	(new-value (append original value))
47	(new-value
48	(if (and (= (length new-value) 1) (not as-array?))
49	(car new-value)
50	(list->array 1 new-value))))
51	(alist-set object key new-value)))
52
53	(define* (compaction active-context inverse-context active-property element
54	#:key (compact-arrays? #f) (ordered? #f) processing-mode)
55	;; 1
56	(let ((type-scoped-context active-context)
57	(def (term-definition-ref active-context active-property)))
58	(cond
59	;; 2
60	((scalar? element)
61	element)
62	;; 3
63	((json-array? element)
64	;; 3.1
65	(let ((result '()))
66	;; 3.2
67	(for-each
68	(lambda (item)
69	;; 3.2.1
70	(let ((compacted-item (compaction active-context inverse-context
71	active-property item
72	#:compact-arrays? compact-arrays?
73	#:ordered? ordered?
74	#:processing-mode processing-mode)))
75	;; 3.2.2
76	(unless (equal? compacted-item #nil)
77	(set! result (cons compacted-item result)))))
78	(array->list element))
79	(set! result (reverse result))
80	(if (let ((container-mapping
81	(container-mapping active-context active-property)))
82	(or (not (= (length result) 1))
83	(equal? compact-arrays? #f)
84	(equal? active-property "@graph")
85	(equal? active-property "@set")
86	(member "@set" container-mapping)
87	(member "@list" container-mapping)))
88	;; 3.3
89	(list->array 1 result)
90	;; 3.4
91	(car result))))
92	;; 4
93	(else
94	;; 5
95	(when (active-context-previous active-context)
96	(unless (or (json-has-key? element "@value")
97	(and (json-has-key? element "@id")
98	(null? (filter (lambda (kp) (not (equal? (car kp) "@id")))
99	element))))
100	(set! active-context (active-context-previous active-context))
101	(set! inverse-context (inverse-context-creation active-context))))
102	;; 6
103	(when (and def (term-definition-context def))
104	;; 6.1
105	(set! active-context
106	(context-processing active-context (term-definition-context def)
107	(term-definition-base-url def)
108	#:override-protected? #t))
109	;; 6.2
110	(set! inverse-context (inverse-context-creation active-context)))
111	;; 7
112	(cond
113	((and (or (json-has-key? element "@value")
114	(json-has-key? element "@id"))
115	(let ((compact
116	(value-compaction active-context inverse-context
117	active-property element processing-mode)))
118	(or (scalar? compact)
119	(and def (equal? (term-definition-type def) "@json")))))
120	(value-compaction active-context inverse-context active-property
121	element processing-mode))
122	;; 8
123	((and (json-has-key? element "@list")
124	(member "@list" (container-mapping active-context active-property)))
125	(compaction active-context inverse-context active-property
126	(assoc-ref element "@list")
127	#:compact-arrays? compact-arrays?
128	#:ordered? ordered?))
129	;; 9 and 10
130	(else
131	(let ((inside-reverse? (equal? active-property "@reverse"))
132	(result '()))
133	;; 11
134	(when (json-has-key? element "@type")
135	(let* ((types (assoc-ref element "@type"))
136	(types (if (json-array? types)
137	(array->list types)
138	(list types)))
139	(compacted-types
140	(map
141	(lambda (type)
142	(iri-compaction active-context inverse-context type
143	#:vocab? #t #:processing-mode processing-mode))
144	types)))
145	(for-each
146	(lambda (term)
147	;; 11.1
148	(when (and
149	(term-definition-ref type-scoped-context term)
150	(term-definition-context
151	(term-definition-ref type-scoped-context term)))
152	;; 11.1.1
153	(set! active-context
154	(context-processing
155	active-context
156	(term-definition-context
157	(term-definition-ref type-scoped-context term))
158	(term-definition-base-url
159	(term-definition-ref type-scoped-context term))
160	#:propagate? #f))
161	;; 11.1.2
162	(set! inverse-context
163	(inverse-context-creation active-context))))
164	(sort compacted-types string<=?))))
165	;; 12
166	(for-each-pair
167	(lambda (expanded-property expanded-value)
168	(set! result
169	(step-12 active-context inverse-context expanded-property
170	expanded-value result compact-arrays? ordered?
171	inside-reverse? type-scoped-context active-property
172	processing-mode)))
173	(if ordered?
174	(alist-sort-by-key element)
175	element))
176	;; 13
177	result)))))))
178
179	(define (step-12 active-context inverse-context expanded-property expanded-value
180	result compact-arrays? ordered? inside-reverse? type-scoped-context
181	active-property processing-mode)
182	(cond
183	;; 12.1
184	((equal? expanded-property "@id")
185	;; XXX: not clear what to do if expanded-value is not a
186	;; string, make sure there is a test
187	(let ((compacted-value
188	(if (string? expanded-value)
189	(iri-compaction active-context inverse-context expanded-value
190	#:vocab? #f #:processing-mode processing-mode)
191	expanded-value))
192	(alias (iri-compaction active-context inverse-context expanded-property
193	#:vocab? #t #:processing-mode processing-mode)))
194	(set! result
195	(alist-set result alias compacted-value))))
196	;; 12.2
197	((equal? expanded-property "@type")
198	(let* ((compacted-value #f)
199	(alias (iri-compaction active-context inverse-context expanded-property
200	#:vocab? #t #:processing-mode processing-mode))
201	(as-array?
202	(or
203	(and
204	(not (processing-mode-1.0? processing-mode))
205	(member "@set" (container-mapping active-context alias)))
206	(not compact-arrays?)))
207	(type-scoped-inverse-context
208	(inverse-context-creation type-scoped-context)))
209	(if (string? expanded-value)
210	(set! compacted-value
211	(iri-compaction type-scoped-context type-scoped-inverse-context
212	expanded-value
213	#:vocab? #t #:processing-mode processing-mode))
214	(begin
215	(set! expanded-value (array->list expanded-value))
216	(set! compacted-value
217	(list->array 1
218	(map
219	(lambda (v)
220	(iri-compaction type-scoped-context type-scoped-inverse-context
221	v
222	#:vocab? #t #:processing-mode processing-mode))
223	expanded-value)))))
224	(when (and (json-array? compacted-value) (= (array-length compacted-value) 1))
225	(set! compacted-value (car (array->list compacted-value))))
226	(set! result
227	(add-value result alias compacted-value as-array?))))
228	;; 12.3
229	((equal? expanded-property "@reverse")
230	(let ((compacted-value
231	(compaction active-context inverse-context "@reverse" expanded-value
232	#:compact-arrays? compact-arrays? #:ordered? ordered?)))
233	;; 12.3.2
234	(for-each-pair
235	(lambda (property value)
236	(let ((def (term-definition-ref active-context property)))
237	(when (and def (term-definition-reverse? def))
238	(let ((as-array? (or
239	(member "@set"
240	(container-mapping active-context property))
241	(not compact-arrays?))))
242	(set! result
243	(add-value result property value as-array?)))
244	(set! compacted-value
245	(alist-remove compacted-value property)))))
246	compacted-value)
247	;; 12.3.3
248	(unless (null? compacted-value)
249	(let ((alias (iri-compaction active-context inverse-context "@reverse"
250	#:vocab? #t #:processing-mode processing-mode)))
251	(set! result (alist-set result alias compacted-value))))))
252	;; 12.4
253	((equal? expanded-property "@preserve")
254	(let ((compacted-value
255	(compaction active-context inverse-context active-property
256	expanded-value #:compact-arrays? compact-arrays?
257	#:ordered? ordered?)))
258	(unless (equal? expanded-value #())
259	(set! result (alist-set result "@preserve" compacted-value)))))
260	;; 12.5
261	((and (equal? expanded-property "@index")
262	(member "@index"
263	(container-mapping active-context active-property)))
264	#t)
265	;; 12.6
266	((or (equal? expanded-property "@direction")
267	(equal? expanded-property "@index")
268	(equal? expanded-property "@language")
269	(equal? expanded-property "@value"))
270	(let ((alias (iri-compaction active-context inverse-context expanded-property
271	#:vocab? #t #:processing-mode processing-mode)))
272	(set! result
273	(alist-set result alias expanded-value))))
274	(else
275	;; 12.7
276	(when (equal? expanded-value #())
277	(let* ((item-active-property
278	(iri-compaction active-context inverse-context expanded-property
279	#:value expanded-value
280	#:vocab? #t
281	#:reverse? inside-reverse?
282	#:processing-mode processing-mode))
283	(def (term-definition-ref active-context
284	item-active-property))
285	(nest-term (if def (term-definition-nest def) #f))
286	;; 12.7.4
287	(nest-result result))
288	;; 12.7.2
289	(when nest-term
290	(unless (or (equal? nest-term "@nest")
291	(equal? (expand-key active-context nest-term)
292	"@nest"))
293	(throw 'invalid-@nest-value))
294	(set! nest-result
295	(if (json-has-key? result nest-term)
296	(assoc-ref result nest-term)
297	'())))
298	;; 12.7.4
299	(set! nest-result
300	(add-value nest-result item-active-property #() #t))
301	(update-result result nest-term nest-result)))
302	;; 12.8
303	(for-each
304	(lambda (expanded-item)
305	(let* ((item-active-property
306	(iri-compaction
307	active-context inverse-context expanded-property
308	#:value expanded-item
309	#:vocab? #t
310	#:reverse? inside-reverse?
311	#:processing-mode processing-mode))
312	(def (term-definition-ref active-context item-active-property))
313	(nest-term (if def (term-definition-nest def) #f))
314	;; 12.8.3
315	(nest-result result)
316	;; 12.8.4
317	(container (container-mapping active-context item-active-property))
318	;; 12.8.5
319	(as-array? (or (member "@set" container)
320	(equal? item-active-property "@list")
321	(equal? item-active-property "@graph")
322	(not compact-arrays?)))
323	;; 12.8.6
324	(compacted-item
325	(compaction active-context inverse-context item-active-property
326	(if (json-has-key? expanded-item
327	"@list")
328	(assoc-ref expanded-item "@list")
329	(if (graph-object? expanded-item)
330	(assoc-ref expanded-item "@graph")
331	expanded-item))
332	#:compact-arrays? compact-arrays?
333	#:ordered? ordered?)))
334	;; 12.8.2
335	(when nest-term
336	(unless (or (equal? nest-term "@nest")
337	(equal? (expand-key active-context nest-term) "@nest"))
338	(throw 'invalid-@nest-value))
339	(set! nest-result
340	(if (json-has-key? result nest-term)
341	(assoc-ref result nest-term)
342	'())))
343	(cond
344	;; 12.8.7
345	((json-has-key? expanded-item "@list")
346	;; 12.8.7.1
347	(unless (json-array? compacted-item)
348	(set! compacted-item `#(,compacted-item)))
349	(if (member "@list" container)
350	;; 12.8.7.3
351	(set! nest-result
352	(alist-set nest-result item-active-property compacted-item))
353	;; 12.8.7.2
354	(begin
355	(set! compacted-item
356	`((,(iri-compaction active-context inverse-context
357	"@list" #:vocab? #t
358	#:processing-mode processing-mode) .
359	,compacted-item)))
360	(when (json-has-key? expanded-item "@index")
361	(set! compacted-item
362	(alist-set
363	compacted-item
364	(iri-compaction active-context inverse-context
365	"@index" #:vocab? #t
366	#:processing-mode processing-mode)
367	(assoc-ref expanded-item "@index"))))
368	(set! nest-result
369	(add-value nest-result item-active-property compacted-item
370	as-array?))))
371	(update-result result nest-term nest-result))
372	;; 12.8.8
373	((graph-object? expanded-item)
374	(cond
375	;; 12.8.8.1
376	((and (member "@id" container)
377	(member "@graph" container))
378	(let* ((map-object
379	(or (assoc-ref nest-result item-active-property) '()))
380	(map-key
381	(if (json-has-key? expanded-item "@id")
382	(assoc-ref expanded-item "@id")
383	"@none"))
384	(map-key
385	(iri-compaction
386	active-context inverse-context map-key
387	#:vocab? (not (json-has-key? expanded-item "@id"))
388	#:processing-mode processing-mode)))
389	;; 12.8.8.1.3
390	(set! map-object
391	(add-value map-object map-key compacted-item as-array?))
392	(set! nest-result
393	(alist-set nest-result item-active-property map-object))
394	(update-result result nest-term nest-result)))
395	;; 12.8.8.2
396	((and (member "@graph" container)
397	(member "@index" container)
398	(simple-graph-object? expanded-item))
399	(let ((map-object
400	(or (assoc-ref nest-result item-active-property) '()))
401	(map-key
402	(if (json-has-key? expanded-item "@index")
403	(assoc-ref expanded-item "@index")
404	"@none")))
405	;; 12.8.8.2.3
406	(set! map-object
407	(add-value map-object map-key compacted-item as-array?))
408	(set! nest-result
409	(alist-set nest-result item-active-property map-object))
410	(update-result result nest-term nest-result)))
411	;; 12.8.8.3
412	((and (member "@graph" container)
413	(simple-graph-object? expanded-item))
414	(when (and (json-array? compacted-item)
415	(> (array-length compacted-item) 1))
416	(set! compacted-item
417	`((,(iri-compaction active-context inverse-context "@included"
418	#:vocab? #t #:processing-mode processing-mode) .
419	,compacted-item))))
420	(set! nest-result
421	(add-value nest-result item-active-property compacted-item
422	as-array?))
423	(update-result result nest-term nest-result))
424	;; 12.8.8.4
425	(else
426	;; 12.8.8.4.1
427	(set! compacted-item
428	`((,(iri-compaction active-context inverse-context "@graph"
429	#:vocab? #t #:processing-mode processing-mode) .
430	,compacted-item)))
431	;; 12.8.8.4.2
432	(when (json-has-key? expanded-item "@id")
433	(set! compacted-item
434	(alist-set
435	compacted-item
436	(iri-compaction active-context inverse-context "@id"
437	#:vocab? #t
438	#:processing-mode processing-mode)
439	(iri-compaction active-context inverse-context
440	(assoc-ref expanded-item "@id")
441	#:vocab? #f
442	#:processing-mode processing-mode))))
443	;; 12.8.8.4.3
444	(when (json-has-key? expanded-item "@index")
445	(set! compacted-item
446	(alist-set
447	compacted-item
448	(iri-compaction active-context inverse-context "@index"
449	#:vocab? #t
450	#:processing-mode processing-mode)
451	(assoc-ref expanded-item "@index"))))
452	;; 12.8.8.4.4
453	(set! nest-result
454	(add-value nest-result item-active-property compacted-item
455	as-array?))
456	(update-result result nest-term nest-result))))
457	;; 12.8.9
458	((and (not (member "@graph" container))
459	(or (member "@language" container)
460	(member "@index" container)
461	(member "@id" container)
462	(member "@type" container)))
463	;; 12.8.9.1
464	(let* ((map-object (or (assoc-ref nest-result item-active-property)
465	'()))
466	;; 12.8.9.2
467	(container-key (iri-compaction active-context inverse-context
468	(cond
469	((member "@language" container) "@language")
470	((member "@index" container) "@index")
471	((member "@id" container) "@id")
472	(else "@type"))
473	#:vocab? #t))
474	(map-key #nil)
475	;; 12.8.9.3
476	(def (term-definition-ref active-context item-active-property))
477	(index-key (or (and def (term-definition-index def)) "@index")))
478	(cond
479	;; 12.8.9.4
480	((and (member "@language" container)
481	(json-has-key? expanded-item "@value"))
482	(set! compacted-item (assoc-ref expanded-item "@value"))
483	(when (json-has-key? expanded-item "@language")
484	(set! map-key (assoc-ref expanded-item "@language"))))
485	;; 12.8.9.5
486	((and (member "@index" container)
487	(equal? index-key "@index"))
488	(when (json-has-key? expanded-item "@index")
489	(set! map-key (assoc-ref expanded-item "@index"))))
490	;; 12.8.9.6
491	((member "@index" container)
492	;; 12.8.9.6.1
493	(set! container-key
494	(iri-compaction active-context inverse-context index-key
495	#:vocab? #t))
496	;; 12.8.9.6.2
497	(let* ((keys (assoc-ref compacted-item container-key))
498	(keys (if (json-array? keys)
499	(array->list keys)
500	(list keys)))
501	(key (and (not (null? keys)) (car keys)))
502	(remaining (if key (cdr keys) '())))
503	(when key
504	(unless (string? key)
505	(set! remaining keys)
506	(set! key #f))
507	(when key
508	(set! map-key key)))
509	;; 12.8.9.6.3
510	(if (null? remaining)
511	(when (json-has-key? compacted-item container-key)
512	(set! compacted-item
513	(alist-remove compacted-item container-key)))
514	(set! compacted-item
515	(alist-set compacted-item container-key
516	(if (= (length remaining) 1)
517	(car remaining)
518	(list->array 1 remaining)))))))
519	;; 12.8.9.7
520	((member "@id" container)
521	(when (json-has-key? compacted-item container-key)
522	(set! map-key (assoc-ref compacted-item container-key))
523	(set! compacted-item (alist-remove compacted-item container-key))))
524	;; 12.8.9.8
525	((member "@type" container)
526	(let* ((keys (assoc-ref compacted-item container-key))
527	(keys (if (json-array? keys)
528	(array->list keys)
529	(list keys)))
530	(key (and (not (null? keys)) (car keys)))
531	(remaining (if key (cdr keys) '())))
532	;; 12.8.9.8.1
533	(when key
534	(set! map-key key))
535	;; 12.8.9.8.2
536	(if (null? remaining)
537	(set! compacted-item
538	(alist-remove compacted-item container-key))
539	(set! compacted-item
540	(alist-set compacted-item container-key
541	(if (= (length remaining) 1)
542	(car remaining)
543	(list->array 1 remaining)))))
544	(when (and (= (length compacted-item) 1)
545	(equal?
546	(expand-key active-context (car (car compacted-item)))
547	"@id"))
548	(set! compacted-item
549	(compaction
550	active-context inverse-context item-active-property
551	`(("@id" . ,(assoc-ref expanded-item "@id")))))))))
552	;; 12.8.9.9
553	(when (equal? map-key #nil)
554	(set! map-key (iri-compaction active-context inverse-context
555	"@none" #:vocab? #t)))
556	;; 12.8.9.10
557	(set! map-object
558	(add-value map-object map-key compacted-item as-array?))
559	(set! nest-result
560	(alist-set nest-result item-active-property map-object))
561	(update-result result nest-term nest-result)))
562	;; 12.8.10
563	(else
564	(set! nest-result
565	(add-value nest-result item-active-property
566	compacted-item as-array?))
567	(update-result result nest-term nest-result)))))
568	(array->list expanded-value))))
569	result)
570