Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/json-ld/frame.lisp

KindCoveredAll%
expression4651165 39.9
branch33104 31.7
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 ;;; (load (compile-file "LIBRARY:org;datagraph;spocq;src;core;encoding;json-ld.lisp" :output-file "json-ld.fasl"))
6
 
7
 ;;; protocol operators
8
 ;;;
9
 ;;;  frame-sparql
10
 ;;;    collate-frame-objects
11
 ;;;      compute-frame-collector
12
 ;;;    mark-root-objects
13
 ;;;    encode-frame-objects
14
 
15
 (defvar json-ld::*frame-level* 0)
16
 (defvar json-ld::*constrain-embedded-types* nil)
17
 
18
 
19
 (defgeneric compute-frame-collector (frame dimensions results)
20
   (:documentation "Given a combination of a constraining frame, the dimensionality of the
21
    source, and some form of source representation, return a function which accepts the respective
22
    succesive solution source and location arguments and accumulates a cache in which each entrs is
23
    on a-list representation of a collatted object.
24
    The result is the equivalent of the json-ld node-map, but represented as term numbers.
25
    The operator performs projection on-the-fly, but leaves the representation in terms of term numbers,
26
    while assembling term number to json key maps for types and properties only.")
27
 
28
   (:method ((frame json-ld:frame) (dimensions cons) (results cons))
29
     "For a result field which contains externalized objects, for each statement
30
      - correlate the respective model-based object description for any subject which is an iri or a blank node.
31
      - record the properties
32
      - record the types
33
      Distinguish results which are graphs from solutions fields.
34
      For a graph, collate the objects step-by-step for each solution.
35
      For a field perform all steps for the subject resource in each solution at once."
36
 
37
     (let* ((property-cache (json-ld:frame-properties frame))
38
            (type-cache (json-ld:frame-types frame))
39
            (object-cache (json-ld:frame-objects frame))
40
            (context (json-ld:frame-context frame))
41
            (subject-vector (json-ld:frame-subjects frame)))
42
       (labels ((note-property (term-id)
43
                  ;; cache projected property keys. when not projected, return nil
44
                  (or (gethash term-id property-cache)
45
                      (let ((property-key.term-id (json-ld:find-term-definition context term-id)))
46
                        (when property-key.term-id
47
                          (setf (gethash term-id property-cache) (car property-key.term-id))))))
48
                (note-member-key (key)
49
                  ;; cache projected property keys. when not projected, return nil
50
                  (or (gethash key property-cache)
51
                      (let ((property-key.term-id (json-ld:find-term-definition context key)))
52
                        (when property-key.term-id
53
                          (setf (gethash key property-cache) (car property-key.term-id))))))
54
                (note-type (term-id)
55
                  (or (gethash term-id type-cache)
56
                      (let ((type-key.term-id (json-ld:find-term-definition context term-id)))
57
                        (setf (gethash term-id type-cache)
58
                              (if type-key.term-id
59
                                (car type-key.term-id)
60
                                (json-ld:lexical-form (term-number-object term-id)))))))
61
                (ensure-subject-entry (s)
62
                  ;; ensure a place to colate the object properties
63
                  (cond ((gethash s object-cache))
64
                        (t
65
                         ;; if no entry exists, create one and append th esubject to the output vector
66
                         (vector-push-extend s subject-vector)
67
                         (setf (gethash s object-cache) (make-node-map-entry :id s)))))
68
                (collect-statement (s p o)
69
                  (when (note-property p)        ; iff the context specifies, to project the property
70
                    (collect-binding (ensure-subject-entry s) p o)))
71
                (collect-binding (subject-entry p o)
72
                  (push (cons p o) (node-map-entry-members subject-entry))
73
                  (when (term-number-typecase o ((:uri :node) t))
74
                    ;; if the object term can identify a resource, then record a place-holder
75
                    (unless (gethash o object-cache)
76
                      (setf (gethash o object-cache) (make-node-map-entry :id o))
77
                      ;; and if the object term is a type,
78
                      (when (json-ld:context-type-predicate-p frame p)
79
                        ;; record the object's type and note the type itself
80
                        (setf (node-map-entry-type subject-entry) o)
81
                        (note-type p)))))
82
                (graph-collector (solution)
83
                  (apply #'collect-statement solution))
84
                (dimension-term-number (dimension)
85
                  (json-ld:term-number (rest (assoc dimension (json-ld:object-members context)))))
86
                (compute-field-collector ()
87
                  (let ((collection-mask (loop for dimension in dimensions
88
                                               collect (note-member-key dimension)))
89
                        (subject-position 0))
90
                    (flet ((collect-solution (solution)
91
                             (let* ((subject (nth subject-position solution))
92
                                    (subject-entry (ensure-subject-entry subject)))
93
                               ;; could just construct the a-list, but then would still need to
94
                               ;; note object existence and type
95
                               (loop for collect-p in collection-mask
96
                                     for dimension in dimensions
97
                                     for value in solution
98
                                     when collect-p
99
                                     do (collect-binding subject-entry (dimension-term-number dimension) value)))))
100
                      #'collect-solution))))
101
         (if (equal dimensions *describe-dimensions*)
102
           #'graph-collector
103
           (compute-field-collector)))))
104
 
105
   (:method ((frame json-ld:frame) (dimensions cons) (results solution-generator))
106
     "For a result field which contains term numbers, for each statement, if the subject
107
      is an iri or a blank node,
108
      - correlate the property with the respective object description
109
      - record the properties
110
      - record the types
111
      - iff the subject was new, append it to the id vector to record its position in the output.
112
      Distinguish results which are graphs from solutions fields.
113
      For a graph, collate the objects step-by-step for each solution.
114
      For a field perform all steps for the subject resource in each solution at once."
115
     (let* ((property-cache (json-ld:frame-properties frame))
116
            (type-cache (json-ld:frame-types frame))
117
            (object-cache (json-ld:frame-objects frame))
118
            (context (json-ld:frame-context frame))
119
            (subject-vector (json-ld:frame-subjects frame))
120
            (explicit (ecase (or (json-ld:frame-explicit frame) json-ld:*explicit*)
121
                       ((nil :|false|) nil)
122
                       ((t :|true|) t)))
123
            (id-property (json-ld:context-id context))
124
            (id-property-term-number (when id-property (json-ld:term-number id-property)))
125
            (type-property (json-ld:context-type context))
126
            (type-property-term-number (when type-property (json-ld:term-number type-property)))
127
            (blank-node-id-term-definition nil))
128
       (log-trace "compute-frame-collector: id-property ~a type-property ~a explicit ~a"
129
                  id-property type-property explicit)
130
       (labels ((property-term-definition (term-number)
131
                  ;; cache projected property keys. when not projected, return nil
132
                  (multiple-value-bind (def def-p)
133
                                       (gethash term-number property-cache)
134
                    (if def-p
135
                        def
136
                        (unless explicit
137
                          (let ((term-definition (or (json-ld:find-term-definition context term-number)
138
                                                     (setf (json-ld:find-term-definition context term-number)
139
                                                           (json-ld:make-term-definition :key nil :term nil :term-number term-number)))))
140
                            (setf (gethash term-number property-cache) term-definition))))))
141
                (dimension-term-definition (dimension)
142
                  (multiple-value-bind (def def-p)
143
                                       (gethash dimension property-cache)
144
                    (if def-p
145
                        def
146
                        (unless explicit
147
                          (let ((term-definition (or (json-ld:find-term-definition context dimension)
148
                                                     (setf (json-ld:find-term-definition context dimension)
149
                                                           (json-ld:make-term-definition :key dimension :term nil :term-number 0)))))
150
                            (setf (gethash dimension property-cache) term-definition))))))
151
                (note-type (term-definition)
152
                  ;; record those properties which are recognized as type relations
153
                  (let ((term-number (json-ld:term-definition-term-number term-definition)))
154
                    (or (gethash term-number type-cache)
155
                        (setf (gethash term-number type-cache)
156
                              term-definition))))
157
                (ensure-subject-entry (key &optional (id (if id-property (cons-blank-node) key)))
158
                  ;; ensure a place to collate the object properties
159
                  ;; if an id property is defined, set the initial id to a blank node as the default
160
                  ;; if none is defined, use the subject key
161
                  (multiple-value-bind (entry registered-p)
162
                                       (gethash key object-cache)
163
                    (log-trace "frame: ensure-subject-entry: ~a ~a ~a ~a ~a"
164
                               key id entry registered-p object-cache)
165
                    (cond (registered-p
166
                           ;; return nil for a suppressed entry
167
                           entry)
168
                          (t
169
                           ;; if no entry exists, create one and append th esubject to the output vector
170
                           (vector-push-extend id subject-vector)
171
                           (setf (gethash key object-cache) (make-node-map-entry :id id))))))
172
 
173
                (collect-statement (s p o)
174
                  ;; collate resource properties by object, but allow that its identity is specified
175
                  ;; by some other property. if no @id was specified, use the subject.
176
                  ;; otherwise, if the declared property does not appear, (as per 9.2 6),
177
                  ;; then introduce a local blank node
178
                  (log-trace "frame: collect-statement (~a ~a ~a)" s p o)
179
                  (let ((subject-entry (ensure-subject-entry s))
180
                        (term-definition (property-term-definition p)))
181
                    ;; override the default id, if the current property was declared as such
182
                    (when (eql id-property-term-number p)
183
                      (setf (node-map-entry-id subject-entry) o))
184
                    ;; iff the frame/context specifies, project the property
185
                    (when term-definition
186
                      (collect-binding subject-entry term-definition o))
187
                    (when (eql type-property-term-number p)
188
                      (setf (node-map-entry-type subject-entry) o))
189
                    (when (term-number-typecase o ((:uri :node) t))
190
                      (ensure-subject-entry o))
191
                    subject-entry))
192
                (graph-generator-collector (page page-index)
193
                  ;; treat the the page as a triple field, (s p o), and add each statement to the graph
194
                  (collect-statement (aref page page-index 0)
195
                                     (aref page page-index 1)
196
                                     (aref page page-index 2)))
197
                (collect-binding (subject-entry term-definition o)
198
                  (let ((existing-member (assoc term-definition (node-map-entry-members subject-entry))))
199
                    (if existing-member
200
                        (if (consp (rest existing-member))
201
                            (push o (rest existing-member))
202
                            (setf (rest existing-member) (list o (rest existing-member))))
203
                        (push (cons term-definition o) (node-map-entry-members subject-entry))))
204
                  (when (term-number-typecase o ((:uri :node) t))
205
                    ;; if the object term can identify a resource, then record a place-holder
206
                    (ensure-subject-entry o)
207
                    (when (json-ld:context-type-predicate-p frame term-definition)
208
                        ;; record the object's type and note the type itself
209
                        (setf (node-map-entry-type subject-entry) o)
210
                        (note-type term-definition))
211
                    #+(or)
212
                    (unless (gethash o object-cache)
213
                      (setf (gethash o object-cache) (make-node-map-entry :id o))
214
                      ;; and if the object term is a type,
215
                      (when (json-ld:context-type-predicate-p frame term-definition)
216
                        ;; record the object's type and note the type itself
217
                        (setf (node-map-entry-type subject-entry) o)
218
                        (note-type term-definition)))))
219
                (blank-node-id-term-definition ()
220
                  (or blank-node-id-term-definition
221
                      (setf blank-node-id-term-definition
222
                            (json-ld:make-term-definition :key @:|@id| :term nil :term-number 0))))
223
                (compute-field-collector (dimensions)
224
                  (let* ((subject-position nil)
225
                         (type-position nil)
226
                         (collection-mask (loop for dimension in dimensions
227
                                                for position from 0
228
                                                for term-definition = (dimension-term-definition dimension)
229
                                                collect term-definition
230
                                                when (and term-definition
231
                                                          (eql id-property-term-number (json-ld:term-number term-definition)))
232
                                                do (setf subject-position position)
233
                                                when (and term-definition
234
                                                          (eql type-property-term-number (json-ld:term-number term-definition)))
235
                                                do (setf type-position position))))
236
                    (when json-ld:*verbose*
237
                      (print (list :compute-field-collector 
238
                                   :subject-position subject-position :type-position type-position
239
                                   :collection-mask collection-mask)))
240
                    (flet ((collect-solution (page page-index)
241
                             ;; cannot enfore the tepy constraint during flattening as it
242
                             ;; can vary by depth according to the active frame
243
                             (log-trace "frame: collect-solution @ ~a" page-index)
244
                             (let* ((subject (if subject-position
245
                                                 (aref page page-index subject-position)
246
                                                 (cons-blank-node)))
247
                                    (subject-entry (ensure-subject-entry subject subject)))
248
                               (when subject-entry ; skip a suppressed entry
249
                                 ;; could just construct the a-list, but then would still need to
250
                                 ;; note object existence and type
251
                                 (log-trace "frame: collect-solution @ ~a . ~a"
252
                                            page-index
253
                                            (loop for term-definition in collection-mask
254
                                              for i from 0
255
                                              when term-definition
256
                                              collect (aref page page-index i)))
257
                                 (loop for term-definition in collection-mask
258
                                   for dimension in dimensions
259
                                   for i from 0
260
                                   when term-definition
261
                                   do (collect-binding subject-entry term-definition (aref page page-index i)))
262
                                 ))))
263
                      #'collect-solution))))
264
         (if (equal dimensions *describe-dimensions*)
265
           #'graph-generator-collector
266
           (compute-field-collector dimensions)))))
267
 
268
   #+matrix-fields ;; uses a different subject entry than the production code
269
   (:method ((frame json-ld:frame) (dimensions cons) (results matrix-field))
270
     (let* ((property-cache (json-ld:frame-properties frame))
271
            (type-cache (json-ld:frame-types frame))
272
            (object-cache (json-ld:frame-objects frame))
273
            (context (json-ld:frame-context frame))
274
            (subject-vector (json-ld:frame-subjects frame)))
275
       (labels ((note-property (term-id)
276
                  ;; cache projected property keys. when not projected, return nil
277
                  (or (gethash term-id property-cache)
278
                      (let ((property-key.term-id (json-ld:find-term-definition context term-id)))
279
                        (when property-key.term-id
280
                          (setf (gethash term-id property-cache) (car property-key.term-id))))))
281
                (note-type (term-id)
282
                  (or (gethash term-id type-cache)
283
                      (let ((type-key.term-id (json-ld:find-term-definition context term-id)))
284
                        (setf (gethash term-id type-cache)
285
                              (if type-key.term-id
286
                                (car type-key.term-id)
287
                                (json-ld:lexical-form (term-number-object term-id)))))))
288
                (ensure-subject-entry (s)
289
                  ;; ensure a place to colate the object properties
290
                  (cond ((gethash s object-cache))
291
                        (t
292
                         ;; if no entry exists, create one and append the subject to the output vector
293
                         (vector-push-extend s subject-vector)
294
                         (setf (gethash s object-cache) `((nil ,s . nil) . nil)))))
295
                (collect-statement (s p o)
296
                  (when (note-property p)        ; iff the context specifies, to project the property
297
                    (collect-binding (ensure-subject-entry s) p o)))
298
                (collect-binding (subject-entry p o)
299
                  (push (cons p o) (rest subject-entry))
300
                  (when (term-number-typecase o ((:uri :node) t))
301
                    ;; if the object term can identify a resource, then record a place-holder
302
                    (unless (gethash o object-cache)
303
                      (setf (gethash o object-cache) `((nil ,o . nil) . nil))
304
                      ;; and if the object term is a type,
305
                      (when (json-ld:context-type-predicate-p frame p)
306
                        ;; record the object's type and note the type itself
307
                        (setf (cddar subject-entry) o)
308
                        (note-type p)))))
309
                (graph-collector (%source-data row-offset)
310
                  (collect-statement (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
311
                                             (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+)
312
                                                            row-offset)))
313
                                     (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
314
                                      (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+)
315
                                                     (+ row-offset 1))))
316
                                     (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
317
                                      (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+)
318
                                                     (+ row-offset 2))))))
319
                (compute-field-collector ()
320
                  (let ((collection-mask (loop for dimension in dimensions
321
                                               collect (note-property dimension)))
322
                        (subject-position 0))
323
                    (flet ((collect-solution (%source-data row-offset)
324
                             (let* ((subject (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
325
                                              (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+)
326
                                                             (+ row-offset subject-position)))))
327
                                    (subject-entry (ensure-subject-entry subject)))
328
                               ;; could just construct the a-list, but then would still need to
329
                               ;; note object existence and type
330
                               (loop for collect-p in collection-mask
331
                                     for dimension in dimensions
332
                                     for term-offset from row-offset
333
                                     when collect-p
334
                                     do (collect-binding subject-entry dimension
335
                                                         (#.+matrix-accessor+ (the sb-sys:system-area-pointer %source-data)
336
                                                          (the fixnum (* #.(cffi:foreign-type-size +matrix-element-type+)
337
                                                                         term-offset))))))))
338
                      #'collect-solution))))
339
         (if (equal dimensions *describe-dimensions*)
340
           #'graph-collector
341
           (compute-field-collector))))))
342
 
343
 
344
 (defgeneric collate-frame-objects (frame results)
345
   (:documentation "Given a frame, which specifies selection criteria and contains a context which
346
    specifies property/dimension mapping, augment the frame with caches of the types, the properties and the
347
    coalesced objects.
348
    the base representation is in terms of term numbers.
349
    the type caches map term numbers to external values.
350
    the object cache maps subject resource term numbers to a composite of
351
      ((ordinal subject-term-id . type-term-id) . (predicate-term-id . object-term-id) ... )")
352
 
353
   (:method ((frame json-ld:frame) (results cons))
354
     (let* ((dimensions (first results))
355
            (solutions (rest results))
356
            (result-count 0)
357
            (index 0)
358
            (start (or (response-offset) 0))
359
            (end (response-end))
360
            (collector (compute-frame-collector frame dimensions results)))
361
       (dolist (solution solutions)
362
         (when (>= index start)
363
           (when (and end (>= index end))
364
             (return))
365
           (funcall collector solution)
366
           (incf result-count)
367
           (when (and *solution-count-limit* (> result-count *solution-count-limit*))
368
             (log-warn "frame: terminated @~a solutions."
369
                       result-count)
370
             (terminate-task *query*)))
371
         (incf index))
372
       (incf-stat *statements-returned* result-count)
373
       result-count))
374
 
375
   (:method ((frame json-ld:frame) (results solution-generator))
376
     "For a result field which contains term numbers, for each statement,
377
      - correlate the respective term-id based object description for any subject which is an iri or a blank node.
378
      - record the properties as a term number - external key map
379
      - record the types as a term number - external key map"
380
     (let* ((channel (solution-generator-channel results))
381
            (dimensions (channel-dimensions channel))
382
            (result-count 0)
383
            (index 0)
384
            (start (or (response-offset) 0))
385
            (end (response-end))
386
            (collector (compute-frame-collector frame dimensions results)))
387
       (log-trace "collate-frame-objects: before frame ~s objects ~s"
388
                  frame (json-ld:frame-objects frame))
389
       (do-pages (page channel)
390
          (if (and end (>= index end))
391
              (return)
392
              (if (>= (+ index (array-dimension page 0)) start)
393
                  (dotimes (page-index (array-dimension page 0))
394
                    ;; (print (list (type-of page) page-index))
395
                    (when (>= index start)
396
                      (when (and end (>= index end))
397
                        (return))
398
                      (funcall collector page page-index)
399
                      (incf result-count)
400
                      (when (and *solution-count-limit* (> result-count *solution-count-limit*))
401
                        (log-warn "frame: terminated @~a solutions."
402
                                  result-count)
403
                        (terminate-task *query*)))
404
                    (incf index))
405
                  ; otherwise skip the entire page
406
                  (incf index (array-dimension page 0)))))
407
       (log-trace "collate-frame-objects: after frame ~s objects ~s"
408
                  frame (json-ld:frame-objects frame))
409
       (incf-stat *statements-returned* result-count)
410
       result-count))
411
 
412
   #+matrix-fields
413
   (:method ((frame json-ld:frame) (results matrix-field))
414
     (let* ((dimensions (solution-field-dimensions results))
415
            (base-width (length dimensions))
416
            (start (or (response-offset) 0))
417
            (end (response-end))
418
            (result-count 0)
419
            (index 0)
420
            (collector (compute-frame-collector frame dimensions results)))
421
       (with-input-fields (results)
422
         (let ((%source-data (cffi::null-pointer))
423
               (source-row 0))
424
           (setf (values %source-data source-row) (first-field-row results))
425
           (loop until (and end (>= index (the fixnum end)))
426
                 until (cffi:null-pointer-p %source-data)
427
                 do (progn
428
                      (trace-matrix "~& collect-frame-objects ~@{~a ~}" :source-row source-row)
429
                      (when (> (incf index) start)
430
                        (funcall collector %source-data (* base-width source-row))
431
                        (incf result-count)
432
                        (when (and *solution-count-limit* (> result-count *solution-count-limit*))
433
                          (log-warn "frame: terminated @~a solutions."
434
                                    result-count)
435
                          (terminate-task *query*))
436
                      (setf (values %source-data source-row) (next-field-row results))))))
437
       (incf-stat *statements-returned* result-count))))
438
 
439
     )
440
 
441
 ;; the json-ld algorithm describes a method which (seems as if it) initially adds each
442
 ;; object to the root set, but then removes it if it appears as a reference.
443
 ;; this requires that the object references be ordered, such that an object will be in the
444
 ;; root set prior to procesing any object which references it. this is not possible with a general graph
445
 ;; in which it is not possible to guarantee all references are "backwards"
446
 
447
 ;; eliminated: the filter step is in each member output as each respective level's frame can
448
 ;; specify different types.
449
 #+(or)
450
 (defgeneric mark-frame-objects (frame)
451
   (:documentation "For each collated object, first test whether it meets the frame's inclusion
452
      criteria. For those which satisfy, mark any objects which appear as values as referenced.
453
      Those which are left un-marked are eligible to be roots")
454
 
455
   (:method ((frame json-ld:frame))
456
     (let ((object-cache (json-ld:frame-objects frame))
457
           (output-cache (json-ld:frame-output-cache frame)))
458
       (loop for object being each hash-value of object-cache
459
             do (setf (gethash object output-cache) (cons nil nil)))
460
       (loop for object being each hash-value of object-cache
461
             do (loop for (key . value) in (json-ld:object-members object)
462
                      for reference = (gethash value object-cache)
463
                      when reference
464
                      do (let ((reference-output-entry (gethash reference output-cache)))
465
                           (if reference-output-entry
466
                             (setf (first reference-output-entry) t)
467
                             (warn "dangling reference: ~s: ~s . ~s: ~s" object key value reference)))))
468
       frame)))
469
 
470
 
471
 (defgeneric encode-frame-objects (frame stream)
472
   (:documentation
473
     "This encodes the top-level framed output. It filters the collated nodes against the frame's type
474
      constraint and emits an array with those which satisfy and which were not yet referenced.
475
      For the respective object, it delegates to encode-frame-object, which either recurses to emit
476
      a new constituent objects or emit an id-object as a reference.
477
 
478
      as per (2.3), this must require one of
479
      - if the frame has a type constraint, the node must satisfy it
480
      - if the frame has an empty object as the type constraint (as opposed to null? or an abstract resource type) match all
481
      - otherwise the node must include _all_ non-keyword terms from the frame
482
     ")
483
 
484
   (:method ((frame json-ld:frame) stream)
485
     (let ((object-cache (json-ld:frame-objects frame))
486
           (subject-vector (json-ld:frame-subjects frame))
487
           (json-ld::*frame-level* 0)
488
           (*thread-byte-buffer* nil)
489
           (graph-name (or (graph-alias frame) "@graph"))
490
           (compact (ecase (or (json-ld:frame-compact frame) json-ld:*compact*)
491
                      ((nil :|false|) nil)
492
                      ((t :|true|) t)))
493
           (embed (case (or (json-ld:frame-embed frame) json-ld:*embed*)
494
                    ((nil :|false|) nil)
495
                    ((t :|true|) t)
496
                    (otherwise (json-ld:frame-embed frame))))
497
           (context (json-ld:frame-context frame))
498
           (count 0))
499
       (log-trace "encode-frame-objects: frame ~s context ~s compat ~s objects ~s"
500
              frame context compact object-cache)
501
       ;; always encode as an array
502
       (when compact
503
         (write-char #\{ stream)
504
         (cond (context
505
                (if embed
506
                    (format stream "~@[\"@context\": ~/format-json/,~% ~]" (json-ld:object-members context))
507
                    (format stream "~@[\"@context\": \"~a\",~% ~]" (json-ld::context-location context))))
508
               (t
509
                ;; include an empty context to permit interpretation as rdf
510
                (format stream "\"@context\": { \"@vocab\": \"\" },~% ")))
511
         (format stream "\"~a\": " graph-name))
512
       (write-char #\[ stream)
513
       (loop with separator-p = nil
514
         for subject across subject-vector
515
         for map-entry = (gethash subject object-cache)
516
         ;; apply the type constraint above each respective level according to the active frame
517
         do (if map-entry
518
                (cond ((frame-typep frame map-entry)
519
                       (when (node-map-entry-members map-entry)
520
                         ;; do not emit top-level entries with no members.
521
                         (when (shiftf separator-p t) (format stream ",~:[~;~%~] " json-ld::*print-pretty*))
522
                         (encode-frame-object frame map-entry stream))
523
                       (incf count))
524
                      (t
525
                       (log-trace "encode-frame-objects: map entry for subject ~s suppressed: ~s"
526
                                  subject frame)))
527
                (log-trace "encode-frame-objects: no map entry for subject ~s . ~s"
528
                                  subject
529
                                  (loop for id being each hash-key of object-cache
530
                                     using (hash-value value)
531
                                     collect (cons id value)))))
532
       (write-char #\] stream)
533
       (when compact (write-char #\} stream))
534
       (terpri stream) 
535
       (values frame count (length subject-vector)))))
536
 
537
 
538
 (defgeneric encode-frame-object (frame object stream)
539
   (:documentation "Realize the encoding as per 10.5 of
540
    https://www.w3.org/TR/json-ld-api/#rdf-to-object-conversion,
541
    but directly from the node definition as term numbers.
542
    The encoding observes the frame's indicated embedding mode, but does
543
    so in a manner which likely paraphrases the specification from
544
    http://json-ld.org/spec/latest/json-ld-framing/, as that concerns
545
    object construction rather than encoding and this implementation
546
    encodes on-the-fly. The intent is:
547
    - at the point of first appearance, if at the toplevel or if embedding
548
      is enabled, then encode the expanded node and mark it complete.
549
    - at subsequent occurrences or if embedding is disables, encode the id
550
      only.
551
    if a prospective node actually has no properties, treat it as an autonomous iri:
552
    - embed it as asimple term
553
    - do not encode the top-level node")
554
 
555
   (:method (frame (map-entry node-map-entry) (stream t))
556
     "If the is the first encounter and either this is the top-level or
557
      embedding is enabled, note the cycle and emit the node members.
558
      For each member, map the name to a frame name, and emit the json encoding
559
      for the term number.
560
      If the node has already been emitted, encode just an id object."
561
 
562
     (let ((json-ld:*frame* frame)
563
           (node-id (node-map-entry-id map-entry))
564
           (id-name (or (frame-id-alias frame) "@id"))
565
           (type-name (or (frame-type-alias frame) "@type"))
566
           (compact (ecase (or (json-ld:frame-compact frame) json-ld:*compact*)
567
                      ((nil :|false|) nil)
568
                      ((t :|true|) t)))
569
           (embed (case (or (json-ld:frame-embed frame) json-ld:*embed*)
570
                    ((nil :|false|) nil)
571
                    ((t :|true|) t)
572
                    (otherwise (json-ld:frame-embed frame))))
573
           (explicit (ecase (or (json-ld:frame-explicit frame) json-ld:*explicit*)
574
                       ((nil :|false|) nil)
575
                       ((t :|true|) t)))
576
           (json-ld::*frame-level* (1+ json-ld::*frame-level*)))
577
 
578
       (log-trace "encode-frame-object: entry ~s, id ~s, id-name ~s, type-name ~s, embed ~s, explicit ~s"
579
                  map-entry node-id id-name type-name embed explicit)
580
       (flet ((embed-node-p (map-entry)
581
                (and (not (eq stream (node-map-entry-cycle map-entry)))
582
                     (or (= 1 json-ld::*frame-level*)
583
                         (case embed
584
                           ((t) t)
585
                           ((nil) nil)
586
                           (otherwise (find (node-map-entry-type map-entry) embed))))))
587
              (pretty-newline ()
588
                (when json-ld::*print-pretty*
589
                  (terpri stream)
590
                  (dotimes (i (1+ (* 2 json-ld::*frame-level*))) (write-char #\space stream)))))
591
         ;;(print (list :pretty json-ld::*print-pretty*))
592
         
593
         (when (eql json-ld::*frame-level* 1) (pretty-newline))
594
         (cond ((null node-id)
595
                (log-warn "encode-frame-object: null id: ~s" map-entry))
596
               ((and (embed-node-p map-entry)
597
                     (node-map-entry-members map-entry))
598
                ;; it's a node with members
599
                ;; mark the node as encoded
600
                (setf (node-map-entry-cycle map-entry) stream)
601
                (flet ((encode-member-key (definition)
602
                         (let* ((key (json-ld:term-definition-key definition))
603
                                (key-lexical-form (if key
604
                                                      (princ-to-string key)
605
                                                      (let* ((number (json-ld:term-definition-term-number definition))
606
                                                             (term-number-object (when number (json-ld:term-object number))))
607
                                                        (if term-number-object
608
                                                            (setf (json-ld:term-definition-key definition)
609
                                                                  (term-lexical-form term-number-object))
610
                                                            (error "No encoding key found for framed member: ~a" definition)))))
611
                                (type-p (equal key-lexical-form "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")))
612
                           ;; patch for rdf:type
613
                           (if type-p
614
                               (format stream "\"~a\"" type-name)
615
                               (if (or (not compact) (is-pname_ln-name key-lexical-form))
616
                                   (format stream "\"~a\"" key-lexical-form)
617
                                   ;; otherwise, try to compact it
618
                                   (format stream "\"~a\"" (or (json-ld:compact-iri frame key-lexical-form)
619
                                                               key-lexical-form))))))
620
                       (emit-separator ()
621
                         (write-string ", " stream)
622
                         (pretty-newline)))
623
                  ;; emit the id - open-ended
624
                  (format stream "{\"~a\": ~/format-json-ld-id/" id-name node-id)
625
                  ;; emit the members
626
                  (let ((objects (json-ld:frame-objects frame))
627
                        (output-members (json-ld:frame-output-members frame)))
628
                  ;; for each member in the map entry, if either the frame is non-explicit
629
                  ;; or the entry member key corresponds to a frame output member, emit any scalar value
630
                  ;; and any object value which satisfies the _output member's_ frame's type specification
631
                    #+(or) (print (list :frame-object.map-entry :frame frame
632
                                 :members (json-ld:frame-output-members frame)
633
                                 :map-entry map-entry
634
                                 :object-cache object-cache))
635
                    (loop
636
                      for (definition . value) in (node-map-entry-members map-entry)
637
                      for output-definition = (find definition output-members :test #'term-definition-equal)
638
                      for output-frame = (if output-definition
639
                                             (json-ld:output-definition-frame output-definition)
640
                                             frame)
641
                      for term-definition = (if output-definition
642
                                                (json-ld:output-definition-term-definition output-definition)
643
                                                definition)
644
                      when json-ld::*verbose*
645
                      do (format *trace-output* "encode-frame-object: def: ~a frame: ~a"
646
                                 definition frame)
647
                      when output-definition
648
                      do (setf output-members (remove output-definition output-members))
649
                      ;; have to test against the spec for the specific frame, as they can differ
650
                      when (or output-definition (not explicit))
651
                      do (labels ((encode-entry (entry)
652
                                    (let ((json-ld:*compact*
653
                                           (or compact
654
                                               (case (json-ld:term-definition-type term-definition)
655
                                                 (@:|@id| t)
656
                                                 (@:|@type| t)
657
                                                 (t nil)))))
658
                                      (typecase entry
659
                                        (integer
660
                                         (encode-member-value entry))
661
                                        (node-map-entry ; it's a reference
662
                                         (let ((key (json-ld:term-definition-key term-definition)))
663
                                           (cond ((or (json-ld:key= key @:|@id|)
664
                                                      (json-ld:key= key @:|@type|)
665
                                                      (equal key "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"))
666
                                                  (encode-json-ld-term-number-compact (node-map-entry-id entry) stream frame term-definition))
667
                                                 ((null (node-map-entry-members entry))
668
                                                  ;; it's a reference, but to nothing in the graph
669
                                                  (encode-member-value (node-map-entry-id entry)))
670
                                                 (t
671
                                                  ;; it's a full reference
672
                                                  (encode-frame-object output-frame entry stream))))))))
673
                                  (encode-member-value (node-id)
674
                                    (if json-ld:*compact*
675
                                        (encode-json-ld-term-number-compact node-id stream frame term-definition)
676
                                        (encode-json-ld-term-number-expanded node-id stream frame term-definition)))
677
                                  (type-constrained-entry (value)
678
                                    (typecase value
679
                                      (integer (let ((value-map-entry (gethash value objects)))
680
                                                 (if value-map-entry
681
                                                     (cond ((json-ld:key= (json-ld:term-definition-key term-definition) @:|@id|)
682
                                                            value)
683
                                                           ((frame-typep output-frame value-map-entry)
684
                                                            value-map-entry))
685
                                                     value)))
686
                                      (cons (loop for value in value
687
                                              for constrained = (type-constrained-entry value)
688
                                              when constrained
689
                                              collect constrained))
690
                                      (t
691
                                       (log-warn "encode-frame-object: anomalous value: ~s" value))))
692
                                  (unconstrained-entry (value)
693
                                    (typecase value
694
                                      (integer (or (gethash value objects) value))
695
                                      (cons (loop for value in value
696
                                              for entry = (unconstrained-entry value)
697
                                              when entry
698
                                              collect entry))
699
                                      (t
700
                                       (log-warn "encode-frame-object: anomalous value: ~s" value)))))
701
                           #+(or) (print (list :frame-object.member :frame frame :value value (json-ld:term-object value)
702
                                               :output-frame output-frame
703
                                               :vme value-map-entry))
704
                           (let ((entry (if json-ld::*constrain-embedded-types*
705
                                            (type-constrained-entry value)
706
                                            (unconstrained-entry value))))
707
                             (when entry
708
                               ;; the id always appears as the first member
709
                               (emit-separator)
710
                               (encode-member-key term-definition)
711
                               (write-string ": " stream)
712
                               (typecase entry
713
                                 ((or integer node-map-entry)
714
                                  (encode-entry entry))
715
                                 (cons
716
                                  (let ((json-ld::*frame-level* (1+ json-ld::*frame-level*)))
717
                                    (write-char #\[ stream)
718
                                    (pretty-newline)
719
                                    (loop for separator-p = nil then t
720
                                      for entry in entry
721
                                      do (progn
722
                                           (when separator-p (emit-separator))
723
                                           (encode-entry entry)))
724
                                    (write-char #\] stream)))
725
                                 (t
726
                                  (log-warn "encode-frame-object: anomalous value entry: ~s" entry))))))
727
                      ;; emit defaults
728
                      finally (unless (json-ld:frame-omit-default frame)
729
                                (loop for output-definition in output-members
730
                                  for term-definition = (json-ld:output-definition-term-definition output-definition)
731
                                  do (progn (emit-separator)
732
                                       (encode-member-key term-definition)
733
                                       (write-string ": " stream)
734
                                       (let ((output-default (json-ld:frame-default frame)))
735
                                         (if output-default
736
                                             (format stream "~s" output-default)
737
                                             (write-string "null" stream)))))))
738
                ;; close the object
739
                (write-char #\} stream))))
740
               ((node-map-entry-members map-entry)
741
                ;; either the object is already encoded, or embedding is disabled:
742
                ;; emit just the id object
743
                (format stream "{\"~a\": ~/format-json-ld-id/}" id-name node-id))
744
               (t
745
                ;; do not emit anything
746
                ))))))
747
 
748
 
749
 ;;;
750
 
751
 (defgeneric frame-sparql (query-string frame &key repository-id id agent stream dataset-graphs indices metadata
752
                                        compact embed pretty)
753
   (:documentation "Provide a direct method to execute a query and emit framed json-ld")
754
 
755
   (:method ((query t) (frame-pathname pathname) &rest args)
756
     (let* ((json (read-file frame-pathname))
757
            (object (parse-json json))
758
            (expanded-frame (json-ld:make-frame object)))
759
       (apply #'frame-sparql query expanded-frame args)))
760
 
761
   (:method ((query-string string) (frame json-ld:frame) &rest args)
762
     (with-configuration ()              ; intended for internal use
763
       (multiple-value-bind (sse-expression options)
764
                            (parse-sparql query-string)
765
         (apply #'frame-sparql sse-expression frame
766
                (append args
767
                        (list* :dataset-graphs *dataset-graphs* options))))))
768
   
769
   (:method ((sse-expression cons) (frame json-ld:frame) &rest args &key (id (make-null-task-id))
770
             (operation (first sse-expression))
771
             dataset-graphs indices metadata
772
             &allow-other-keys)
773
     (declare (ignore dataset-graphs indices metadata))
774
     (apply #'frame-sparql
775
            (apply #'make-query
776
                   :id  id
777
                   :operation operation
778
                   :sse-expression sse-expression
779
                   :request-exchange "test" :request-routing-key "key"
780
                   :store-routing-key "host.app.pid"
781
                   :trace-routing-key nil
782
                   :accept "application/ld+json"
783
                   (plist-difference args '(:accounting-handler :error-handler :continuation :stream
784
                                                                :embed :compact :pretty)))
785
            frame
786
            args))
787
 
788
   (:method ((task task) (frame json-ld:frame) &rest args)
789
     (let ((post-result ())
790
           (dimensions ()))
791
       (restart-case
792
         (block :handle-termination
793
           (add-task-thread task (bt:current-thread))
794
           (restart-bind ((terminate-task (lambda (task-to-terminate &optional condition)
795
                                            (when (eq task task-to-terminate)
796
                                              (warn "task terminated: ~a" task-to-terminate)
797
                                              (setf post-result :terminated)
798
                                              (return-from :handle-termination (values condition nil task))))))
799
             (with-task-environment (:task task)
800
               (unless (task-initialization-function task)
801
                 (compile-query task)
802
                 (generate-accounting-note :abstract))
803
               (initialize-task task)
804
               (let ((generator (task-result-generator task)))
805
                 (when (abstract-field-generator-p generator)
806
                   (query-run-in-thread task generator))
807
                 (apply #'frame-sparql generator frame args)))))
808
         (return-query () (values nil dimensions task)))))
809
 
810
   #+matrix-fields
811
   (:method ((field matrix-field) (frame json-ld:frame) &key (stream *standard-output*) &allow-other-keys)
812
     (collate-frame-objects frame field)
813
     (encode-frame-objects frame stream))
814
 
815
   (:method ((generator abstract-field-generator) (frame json-ld:frame) &key (stream *standard-output*)
816
             ((:compact json-ld:*compact*) json-ld:*compact*)
817
             ((:embed json-ld:*embed*) json-ld:*embed*)
818
             ((:pretty json-ld::*print-pretty*) json-ld::*print-pretty*)
819
             &allow-other-keys)
820
     #+(or) (print (list :frame-sparql :compact json-ld:*compact* :embed json-ld:*embed*))
821
     (collate-frame-objects frame generator)
822
     (encode-frame-objects frame stream)
823
     (terpri stream)
824
     frame))
825
 
826
 #|
827
 ;;; this method implemention is obsolete. it predates the inline term encoding
828
   #+(or) ;; modified encoding implementation
829
   (:method (frame (map-entry node-map-entry) (stream t))
830
     "If the is the first encounter and either this is the top-level or
831
      embedding is enabled, note the cycle and emit the node members.
832
      For each member, map the name to a frame name, and emit the json encoding
833
      for the term number.
834
      If the node has already been emitted, encode just an id object."
835
 
836
     (let ((json-ld:*frame* frame)
837
           (node-id (node-map-entry-id map-entry))
838
           (id-name (or (frame-id-alias frame) "@id"))
839
           (type-name (or (frame-type-alias frame) "@type"))
840
           (compact (ecase (or (json-ld:frame-compact frame) json-ld:*compact*)
841
                      ((nil :|false|) nil)
842
                      ((t :|true|) t)))
843
           (embed (case (or (json-ld:frame-embed frame) json-ld:*embed*)
844
                    ((nil :|false|) nil)
845
                    ((t :|true|) t)
846
                    (otherwise (json-ld:frame-embed frame))))
847
           (explicit (ecase (or (json-ld:frame-explicit frame) json-ld:*explicit*)
848
                       ((nil :|false|) nil)
849
                       ((t :|true|) t)))
850
           (json-ld::*frame-level* (1+ json-ld::*frame-level*)))
851
       (log-trace "encode-frame-object: entry ~s, id ~s, id-name ~s, type-name ~s, embed ~s, explicit ~s"
852
                  map-entry node-id id-name type-name embed explicit)
853
       (flet ((embed-node-p (map-entry)
854
                (and (not (eq stream (node-map-entry-cycle map-entry)))
855
                     (or (= 1 json-ld::*frame-level*)
856
                         (case embed
857
                           ((t) t)
858
                           ((nil) nil)
859
                           (otherwise (find (node-map-entry-type map-entry) embed))))))
860
              (pretty-newline ()
861
                (when json-ld::*print-pretty*
862
                  (terpri stream)
863
                  (dotimes (i (1+ (* 2 json-ld::*frame-level*))) (write-char #\space stream)))))
864
         ;;(print (list :pretty json-ld::*print-pretty*))
865
         
866
         (when (eql json-ld::*frame-level* 1) (pretty-newline))
867
         (cond ((null node-id)
868
                (log-warn "encode-frame-object: null id: ~s" map-entry))
869
               ((embed-node-p map-entry)
870
                ;; mark the node as encoded
871
                (setf (node-map-entry-cycle map-entry) stream)
872
                (flet ((encode-member-key (definition)
873
                         (let* ((key (json-ld:term-definition-key definition))
874
                                (key-lexical-form (if key
875
                                                      (princ-to-string key)
876
                                                      (let* ((number (json-ld:term-definition-term-number definition))
877
                                                             (term-number-object (when number (json-ld:term-object number))))
878
                                                        (if term-number-object
879
                                                            (setf (json-ld:term-definition-key definition)
880
                                                                  (term-lexical-form term-number-object))
881
                                                            (error "No encoding key found for framed member: ~a" definition)))))
882
                                (type-p (equal key-lexical-form "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")))
883
                           ;; patch for rdf:type
884
                           (if type-p
885
                               (format stream "\"~a\"" type-name)
886
                               (if (or (not compact) (is-pname_ln-name key-lexical-form))
887
                                   (format stream "\"~a\"" key-lexical-form)
888
                                   ;; otherwise, try to compact it
889
                                   (format stream "\"~a\"" (or (json-ld:compact-iri frame key-lexical-form)
890
                                                               key-lexical-form))))))
891
                       (emit-separator ()
892
                         (write-string ", " stream)
893
                         (pretty-newline)))
894
                  ;; emit the id - open-ended
895
                  (format stream "{\"~a\": ~/format-json-ld-id/" id-name node-id)
896
                  ;; emit the members
897
                  (let ((term-deconstructor (repository-term-deconstructor *transaction*))
898
                        (objects (json-ld:frame-objects frame))
899
                        (output-members (json-ld:frame-output-members frame)))
900
                  ;; for each member in the map entry, if either the frame is non-explicit
901
                  ;; or the entry member key corresponds to a frame output member, emit any scalar value
902
                  ;; and any object value which satisfies the _output member's_ frame's type specification
903
                    #+(or) (print (list :frame-object.map-entry :frame frame
904
                                 :members (json-ld:frame-output-members frame)
905
                                 :map-entry map-entry
906
                                 :object-cache object-cache))
907
                    (loop
908
                      for (definition . value) in (node-map-entry-members map-entry)
909
                      for output-definition = (find definition output-members :test #'term-definition-equal)
910
                      for output-frame = (if output-definition
911
                                             (json-ld:output-definition-frame output-definition)
912
                                             frame)
913
                      for term-definition = (if output-definition
914
                                                (json-ld:output-definition-term-definition output-definition)
915
                                                definition)
916
                      when json-ld::*verbose*
917
                      do (format *trace-output* "encode-frame-object: def: ~a frame: ~a"
918
                                 definition frame)
919
                      when output-definition
920
                      do (setf output-members (remove output-definition output-members))
921
                      ;; have to test against the spec for the specific frame, as they can differ
922
                      when (or output-definition (not explicit))
923
                      do (labels ((term-aspect-encoder (term-type %term-literal term-language-tag term-datatype)
924
                                    ;; (print (list term-type term-literal))
925
                                    (encode-json-ld-term-aspects frame definition
926
                                                                 term-type %term-literal term-language-tag term-datatype
927
                                                                 stream))
928
                                  (encode-entry (entry)
929
                                    (typecase entry
930
                                      (integer
931
                                       (funcall term-deconstructor #'term-aspect-encoder *transaction* entry))
932
                                      (node-map-entry ; it's a reference
933
                                       (if (json-ld:key= (json-ld:term-definition-key term-definition) @:|@id|)
934
                                           (funcall term-deconstructor #'term-aspect-encoder *transaction*
935
                                                    (node-map-entry-id entry))
936
                                           (encode-frame-object output-frame entry stream)))))
937
                                  (type-constrained-entry (value)
938
                                    (typecase value
939
                                      (integer (let ((value-map-entry (gethash value objects)))
940
                                                 (if value-map-entry
941
                                                     (cond ((json-ld:key= (json-ld:term-definition-key term-definition) @:|@id|)
942
                                                            value)
943
                                                           ((frame-typep output-frame value-map-entry)
944
                                                            value-map-entry))
945
                                                     value)))
946
                                      (cons (loop for value in value
947
                                              for constrained = (type-constrained-entry value)
948
                                              when constrained
949
                                              collect constrained))
950
                                      (t
951
                                       (log-warn "encode-frame-object: anomalous value: ~s" value))))
952
                                  (unconstrained-entry (value)
953
                                    (typecase value
954
                                      (integer (or (gethash value objects) value))
955
                                      (cons (loop for value in value
956
                                              for entry = (unconstrained-entry value)
957
                                              when entry
958
                                              collect entry))
959
                                      (t
960
                                       (log-warn "encode-frame-object: anomalous value: ~s" value)))))
961
                           (declare (dynamic-extent #'term-aspect-encoder))
962
                           #+(or) (print (list :frame-object.member :frame frame :value value (json-ld:term-object value)
963
                                               :output-frame output-frame
964
                                               :vme value-map-entry))
965
                           (let ((entry (if json-ld::*constrain-embedded-types*
966
                                            (type-constrained-entry value)
967
                                            (unconstrained-entry value))))
968
                             (when entry
969
                               ;; the id always appears as the first member
970
                               (emit-separator)
971
                               ;; (print (list definition value value-object))
972
                               (encode-member-key term-definition)
973
                               (write-string ": " stream)
974
                               (typecase entry
975
                                 ((or integer node-map-entry)
976
                                  (encode-entry entry))
977
                                 (cons
978
                                  (let ((json-ld::*frame-level* (1+ json-ld::*frame-level*)))
979
                                    (write-char #\[ stream)
980
                                    (pretty-newline)
981
                                    (loop for separator-p = nil then t
982
                                      for entry in entry
983
                                      do (progn
984
                                           (when separator-p (emit-separator))
985
                                           (encode-entry entry)))
986
                                    (write-char #\] stream)))
987
                                 (t
988
                                  (log-warn "encode-frame-object: anomalous value entry: ~s" entry))))))
989
                      ;; emit defaults
990
                      finally (unless (json-ld:frame-omit-default frame)
991
                                (loop for output-definition in output-members
992
                                  for term-definition = (json-ld:output-definition-term-definition output-definition)
993
                                  do (progn (emit-separator)
994
                                       (encode-member-key term-definition)
995
                                       (write-string ": " stream)
996
                                       (let ((output-default (json-ld:frame-default frame)))
997
                                         (if output-default
998
                                             (format stream "~s" output-default)
999
                                             (write-string "null" stream)))))))
1000
                ;; close the object
1001
                (write-char #\} stream))))
1002
               (t
1003
                ;; either the object is already encoded, or embedding is disabled:
1004
                ;; emit just the id object
1005
                (format stream "{\"~a\": ~/format-json-ld-id/}" id-name node-id))))))
1006
 
1007
 |#