Coverage report: /development/source/library/org/datagraph/spocq-shard/src/algebra/operators/temporal-operators.lisp

KindCoveredAll%
expression8091674 48.3
branch3972 54.2
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
 (:documentation "This file defines the standard SPARQL operators for dateTime values and
6
  the extended XPath temporal operators for the 'org.datagraph.spocq' RDF engine."
7
 
8
  (copyright
9
   "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
10
 
11
  (long-description
12
   "The file defines the operators for SPOCQ from the 'SPARQL Query Language for RDF'[1] recommendation
13
  and also the additional temporal operators from the 'XPath and XQuery Functions and Operators 3.0'[2] recommendation.
14
  The definition pattern is the same as for the core algebra operators.
15
  The construction, combination and promotion rules are those specified for XPath[3].
16
 
17
  The datatypes are (with respective '-' / camel-case transformations)
18
  - date
19
  - date-time
20
  - day-time-duration
21
  - duration
22
  - g-day
23
  - g-month
24
  - g-month-day
25
  - g-year
26
  - g-year-month
27
  - time
28
  - year-month-duration
29
 
30
  There are four operator classes:
31
  - constructors, which also perform casts
32
  - accessors
33
  - predicates 
34
  - combinations
35
 
36
  This implementation prescribes ZULU as the implicit timezone component of the dynamic context[4].
37
  As that value is a static constant and, as such pervasive, all data is canonicalized to zulu time
38
  upon construction.
39
 
40
  The implementation evolved from one in which all instances included canonicalization to zulu time
41
  as part of instantiation, into one in which the fragments were canonicalized, into one in which
42
  nothing extra which nothing is done until either the location value or a fragment is required,
43
  at which point that is produced according to
44
    lexical form -> fragments -> location value(s)
45
  that is, they retain as much as they can as late as they can.
46
  given values and the zone and do not perform canonicalization inorder to generate the location value
47
  until it is required, at which point the zone is applied.
48
 
49
  nb. temporal predicates are defined here as well as accessors and combinations.
50
  all predicates require the types to match.
51
  nb. no order is defined for Gregorians
52
     The only operations defined on xs:gYearMonth, xs:gYear, xs:gMonthDay, xs:gMonth and xs:gDay values 
53
     are equality comparison and component extraction. For other types, further operations are provided,
54
     including order comparisons, arithmetic, formatted display, and timezone adjustment.[5]
55
     2020-05-02: This reference falls back to starting instance, which does allow comparisons
56
 
57
  ---
58
  [1]: http://www.w3.org/TR/rdf-sparql-query/#OperatorMapping.
59
  [2]: http://www.w3.org/TR/xpath-functions-30/
60
  [3]: http://www.w3.org/TR/xpath-functions-30/#casting
61
  [4]: http://www.w3.org/TR/xpath-30/#id-xp-evaluation-context-components
62
  [5]: http://www.w3.org/TR/xpath-functions-30/#date-time-types
63
 "))
64
 
65
 
66
 ;;; colloquialisms
67
 
68
 (defmacro spocq.a:|now| ()
69
   "( () xsd:dateTime )
70
 The function NOW returns an XSD dateTime value for the current query execution.
71
 All calls to this function in any one query execution must return the same
72
 value.
73
 The moment is that recorded when the query process was created."
74
   '(spocq.e:now))
75
 
76
 (defun spocq.e:now ()
77
   "Return the 'current' time for the evaluation of a given query.
78
  This is the universal time point hen the query initialized."
79
   (universal-time-date-time (if *task* (task-start-time *task*) (get-universal-time))))
80
 
81
 (defmacro spocq.a:|then| ()
82
   '(spocq.e:then))
83
 
84
 ;;; originally for use with an universal time. currently applies to the current revision
85
 ;;; the universal time case should use universal-time-date
86
 (defun spocq.e:then ()
87
   (repository-revision-date-time *repository*))
88
 
89
 (defun spocq.e::unix-now ()
90
   #+sbcl
91
   (multiple-value-bind (sec microsec) (sb-ext:get-time-of-day)
92
     (+ (* sec 1000000) microsec))
93
   #-sbcl #.(error "no get-time-of-day"))
94
 (defconstant unix-timestamp-units-per-second 1000000)
95
 
96
 ;;; abstract operators for temporals, gregorians
97
 
98
 (defgeneric decode-temporal (value &optional zone)
99
   (:documentation "Decode the given concrete temporal instance")
100
 
101
   (:method :around ((object spocq:temporal) &optional (zone nil zp-p))
102
     (multiple-value-bind (fraction second minute hour day month year)
103
                          (call-next-method)
104
       (unless zp-p (setf zone (spocq:temporal-zone object)))
105
       (if (offset-zone-p zone)
106
           (canonicalize-date-time-fragments fraction second minute hour day month year 0 zone)
107
           (values fraction second minute hour day month year))))
108
 
109
   (:method ((object integer) &optional zone)
110
     (dydra-ndk::decode-time object (or zone spocq:+reference-zone+))))
111
 
112
 (defun temporal-zone (temporal)
113
   (unless (temporal-decoded-p temporal)
114
     (decode-temporal temporal))
115
   (spocq:temporal-zone temporal))
116
 
117
 (defun decode-extended-time (value &optional zone) (decode-temporal value zone))
118
 
119
 (macrolet ((def-slot-accessors (class &rest slots)
120
              (let ((decoder (cons-symbol :spocq.i :decode- class))
121
                    (decoded-names '(fraction second minute hour day month year zone))
122
                    (spocq-type (or (find-symbol (symbol-name class) :spocq)
123
                                    (error "invalid temporal class: ~s" class))))
124
                `(progn
125
                   ,@(loop for slot in slots
126
                           for name = (if (consp slot) (first slot) slot)
127
                           for type = (if (consp slot) (getf (rest slot) :type) 'fixnum)
128
                           collect (let* ((spocq.i (cons-symbol :spocq.i class "-" name))
129
                                          (spocq (or (find-symbol (symbol-name spocq.i) :spocq)
130
                                                     (error "invalid field: ~s" name))))
131
                                  `(progn (defun ,spocq.i (,class)
132
                                             (or (,spocq ,class)
133
                                                 (nth-value ,(position name decoded-names) (,decoder ,class))))
134
                                          (defmethod decode-temporal ((temporal ,spocq-type) &optional zone)
135
                                            (declare (ignore zone))
136
                                            (,decoder temporal))
137
                                           (define-compiler-macro ,spocq.i (,class)
138
                                             (list 'or (list ',spocq ,class)
139
                                                   (list 'nth-value ,(position name decoded-names) (list ',decoder ,class))))
140
                                           (declaim (ftype (function (,spocq-type) ,type) ,spocq.i)))))))))
141
   (def-slot-accessors date minute hour day month year zone)
142
   (def-slot-accessors date-time fraction second minute hour day month year zone)
143
   (def-slot-accessors day-time-duration fraction second minute hour day zone)
144
   (def-slot-accessors duration fraction second minute hour day month year zone)
145
   (def-slot-accessors g-day day zone)
146
   (def-slot-accessors g-month month zone)
147
   (def-slot-accessors g-month-day month day zone)
148
   (def-slot-accessors g-year year zone)
149
   (def-slot-accessors g-year-month year month zone)
150
   (def-slot-accessors time fraction second minute hour zone)
151
   (def-slot-accessors year-month-duration month year zone))
152
 
153
 
154
 (macrolet ((def-temporal-accessor ((interface-op implementation-op &optional (accessor implementation-op))
155
                                    (parameter . classes) documentation
156
                              &optional (result-type t))
157
              ;; accept both date, date-time and duration
158
              (setf documentation (format nil "( (or~{ ~a~}) ) ~a~%~a" classes result-type documentation))
159
              `(progn (define-compiler-macro ,interface-op (,parameter)
160
                        (setf (variable-opacity (expression-variables ,parameter)) :transparent)
161
                        (list ',implementation-op ,parameter))
162
                      (defun ,interface-op (,parameter)
163
                        ,documentation
164
                        (,implementation-op ,parameter))
165
                      (declaim (ftype (function ((or ,@classes)) ,result-type) ,implementation-op))
166
                      (defgeneric ,implementation-op (,parameter)
167
                        (:documentation ,documentation)
168
                        ,@(loop for class in classes
169
                            collect `(:method ((,parameter ,class))
170
                                       (,(cons-symbol :spocq.i class :- accessor) ,parameter))))))
171
            )
172
 
173
   (def-temporal-accessor (spocq.a:|year| spocq.e:year)
174
     (arg spocq:date spocq:date-time spocq:year-month-duration spocq:g-year spocq:g-year-month)
175
     "The function YEAR returns the year part of arg as an integer.
176
      This function corresponds to fn:year-from-dateTime.")
177
   (def-temporal-accessor (spocq.a:|month| spocq.e:month)
178
     (arg spocq:date spocq:date-time spocq:year-month-duration spocq:g-month spocq:g-month-day spocq:g-year-month)
179
     "The function MONTH returns the month part of arg as an integer.
180
      This function corresponds to fn:month-from-dateTime.")
181
   (def-temporal-accessor (spocq.a:|day| spocq.e:day)
182
     (arg spocq:date spocq:date-time spocq:day-time-duration spocq:g-day spocq:g-month-day)
183
     "The function DAY returns the day part of arg as an integer.
184
      This function corresponds to fn:day-from-dateTime and its variations.")
185
   (def-temporal-accessor (spocq.a:|hours| spocq.e:hours hour)
186
     (arg spocq:date-time spocq:day-time-duration spocq:time)
187
     "The function HOURS returns the hours part of arg as an integer.
188
      The value is as given in the lexical form of the XSD dateTime.
189
      This function corresponds to fn:hours-from-dateTime.")
190
   (def-temporal-accessor (spocq.a:|minutes| spocq.e:minutes minute)
191
     (arg spocq:date-time spocq:day-time-duration spocq:time)
192
     "The function MINUTES returns the minutes part of the lexical form of arg.
193
      The value is as given in the lexical form of the XSD dateTime.
194
      This function corresponds to fn:minutes-from-dateTime.")
195
   #+(or)                                ; must be implemented differently, below
196
   (def-temporal-accessor (spocq.a:|seconds| spocq.e:seconds second)
197
     (arg spocq:date-time spocq:day-time-duration spocq:time)
198
     "The function SECONDS returns the seconds part of the lexical form of arg.
199
      This function corresponds to fn:seconds-from-dateTime."))
200
 
201
 ;;; certain cases are over-ridden
202
 
203
 (defmethod spocq.e:year ((object spocq:day-time-duration)) 0)
204
 (defmethod spocq.e:month ((object spocq:day-time-duration)) 0)
205
 (defmethod spocq.e:day ((object spocq:year-month-duration)) 0)
206
 (defmethod spocq.e:hours ((object spocq:year-month-duration)) 0)
207
 (defmethod spocq.e:minutes ((object spocq:year-month-duration)) 0)
208
 (defmethod spocq.e:seconds ((object spocq:year-month-duration)) 0)
209
 
210
 ;;; second must be computed
211
 (define-compiler-macro spocq.a:|seconds| (arg)
212
   (setf (variable-opacity (expression-variables arg)) :transparent)
213
   `(spocq.e:seconds ,arg))
214
 
215
 (defun spocq.a:|seconds| (arg)
216
   "( (or date-time day-time-duration time) ) t
217
 the function seconds returns the seconds part of the lexical form of arg.
218
      this function corresponds to fn:seconds-from-datetime."
219
    (org.datagraph.spocq.evaluation:seconds arg))
220
 
221
 (flet ((compute-real-seconds (second fraction)
222
          (if (zerop fraction)
223
            second
224
            (+ second (float (/ fraction +timeline-units-per-second+))))))
225
   (defgeneric spocq.e:seconds (arg)
226
     (:documentation "( (or date-time day-time-duration time) ) t
227
 the function seconds returns the seconds part of the lexical form of arg.
228
      this function corresponds to fn:seconds-from-datetime.")
229
     (:method ((arg spocq:date-time)) (compute-real-seconds (date-time-second arg) (date-time-fraction arg)))
230
     (:method ((arg spocq:day-time-duration)) (compute-real-seconds (day-time-duration-second arg) (day-time-duration-fraction arg)))
231
     (:method ((arg spocq:time)) (compute-real-seconds (time-second arg) (time-fraction arg)))))
232
 
233
 (declaim (ftype (function ((or spocq:date-time spocq:day-time-duration spocq:time)) t)
234
    org.datagraph.spocq.evaluation:seconds))
235
 
236
 
237
 
238
 (defmacro spocq.a::|timezone| (arg)
239
   "( ( xsd:dateTime ) xsd:dayTimeDuration ) 
240
 The function TIMEZONE returns the timezone part of arg as an xsd:dayTimeDuration. Raises an error if there is no timezone.
241
 This function corresponds to fn:timezone-from-dateTime except for the treatment of literals with no timezone.
242
 As all values are represented as zulu times, the function constantly returns
243
 'PT0S'^^xsd:dayTimeDuration.
244
 "
245
   (setf (variable-opacity (expression-variables arg)) :transparent)
246
   `(spocq.e:time-zone ,arg))
247
 
248
 (defgeneric spocq.e:time-zone (term)
249
   (:method ((term spocq:temporal))
250
     ;; all date-time values are canonicalized to zulu time
251
     (let ((zone-offset (temporal-zone term)))
252
       (case zone-offset
253
         ((nil) (invalid-argument-type spocq.a::|timezone| term spocq:temporal))
254
         (0 (zero-duration))
255
         (t (multiple-value-bind (hours minutes) (truncate zone-offset)
256
              (spocq:make-day-time-duration :fraction 0 :second 0 :minute minutes :hour hours :day 0))))))
257
   (:method ((term spocq:duration))
258
     (invalid-argument-type spocq.a::|timezone| term spocq:temporal))
259
   (:method ((term t))
260
     (invalid-argument-type spocq.a::|timezone| term spocq:temporal)))
261
 
262
 
263
 (define-compiler-macro spocq.a::|tz| (arg)
264
   (setf (variable-opacity (expression-variables arg)) :transparent)
265
   `(spocq.e:tz ,arg))
266
 
267
 (defun spocq.a::|tz| (arg)
268
   "( ( xsd:dateTime ) simpleLiteral )
269
 The function TZ returns the timezone part of arg as an xsd:dayTimeDuration.
270
 Raises an error if there is no timezone.
271
 This function corresponds to fn:timezone-from-dateTime except for the treatment of literals with no timezone.
272
 As all times are recorded as zulu times, the function constantly returns 'Z'"
273
   (spocq.e:tz arg))
274
 
275
 (defgeneric spocq.e:tz (term)
276
   (:method ((term spocq:temporal))
277
     (with-output-to-string (stream) (spocq:format-zone-offset stream (temporal-zone term) nil)))
278
   (:method ((term spocq:duration))
279
     (invalid-argument-type spocq.a::|tz| term spocq:temporal))
280
   (:method ((term t))
281
     (invalid-argument-type spocq.a::|tz| term spocq:date-time)))
282
 
283
 ;;; concrete classes
284
 
285
 ;;; date
286
 
287
 (defmacro |xsd|:|date| (expression)
288
   "( ( (or xsd:string numeric) ) xsd:date )"
289
   (setf (variable-opacity (expression-variables expression)) :transparent)
290
   `(spocq.e:date ,expression))
291
 
292
 (defgeneric spocq.e:date (object)
293
   (:method ((object string))
294
     (let ((result (intern-term-aspects :literal object |xsd|:|date| nil)))
295
       (typecase result
296
         (spocq:date result)
297
         (t (call-next-method)))))
298
   (:method ((object spocq:date-time))
299
     (multiple-value-bind (fraction second minute hour day month year)
300
                          (decode-date-time object)
301
       (declare (ignore fraction second minute hour))
302
       (spocq:make-date :year year :month month :day day
303
                        :minute 0 :hour 0)))
304
   (:method ((object spocq:date))
305
     object)
306
   (:method ((object integer))
307
     (timeline-location-date (* +timeline-units-per-second+ object)))
308
   (:method ((object real))
309
     (timeline-location-date (truncate (* +timeline-units-per-second+ object))))
310
   (:method ((object t))
311
    (invalid-argument-type |xsd|:|date| object |xsd|:|date|)))
312
 
313
 (macrolet ((def-xpath-date-accessor (xpath-op implementation-op)
314
              `(progn (defun ,xpath-op (term)
315
                        "( ( xsd:date ) xsd:integer )"
316
                        (,implementation-op term))
317
                      (define-compiler-macro ,xpath-op (expression)
318
                        (setf (variable-opacity (expression-variables expression)) :transparent)
319
                        (list ',implementation-op expression)))))
320
   (def-xpath-date-accessor |fn|:|day-from-date| spocq.e:day)
321
   (def-xpath-date-accessor |fn|:|month-from-date| spocq.e:month)
322
   (def-xpath-date-accessor |fn|:|timezone-from-date| spocq.e:time-zone)
323
   (def-xpath-date-accessor |fn|:|year-from-date| spocq.e:year))
324
 
325
 (defmethod spocq.e:same-term ((term1 spocq:date) (term2 spocq:date))
326
   "Compare the canonicalized term values. Strict term identity would require also that the zones match."
327
   (= (date-timeline-location term1) (date-timeline-location term2)))
328
 
329
 (defmethod spocq.e:= ((term1 spocq:date) (term2 spocq:date))
330
   "Compare the canonicalized term values."
331
   (= (date-timeline-location term1) (date-timeline-location term2)))
332
 
333
 (defmethod spocq.e:< ((term1 spocq:date) (term2 spocq:date))
334
   "Compare the canonicalized term values."
335
   (< (date-timeline-location term1) (date-timeline-location term2)))
336
 
337
 (defmethod spocq.e:<= ((term1 spocq:date) (term2 spocq:date))
338
   "Compare the canonicalized term values."
339
   (<= (date-timeline-location term1) (date-timeline-location term2)))
340
 
341
 (defmethod spocq.e:|+| ((date spocq:date) (time spocq:time))
342
   "Combine a time with a date sa a linear combiation, as the time should never exceed 24 hours.
343
    Adopt the time zone unless the date is alreadz offset"
344
   (let ((zone (date-zone date)))
345
     ;; if the date is not offset, allow the time to set the zone
346
     (unless (offset-zone-p zone) (setf zone (or (time-zone time) spocq:+reference-zone+)))
347
     (spocq:make-date-time :fraction (time-fraction time) :second (time-second time)
348
                           :minute (time-minute time) :hour (time-hour time)
349
                           :day (date-day date) :month (date-month date)
350
                           :year (date-year date)
351
                           :zone zone)
352
     #+(or)
353
     (spocq:make-date-time :timeline-location (+ (date-timeline-location date) (time-timeline-location time))
354
                           :zone zone)))
355
 
356
 (defmethod spocq.e:|+| ((time spocq:time) (date spocq:date))
357
   (spocq.e:|+| date time))
358
 
359
 (defmethod spocq.e:|+| ((date spocq:date) (duration spocq:day-time-duration))
360
   "Combine the 00:00:00 date with the given time and normalize.
361
  This requires deconstruction in order to effect the correct day/month normalization.
362
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-dayTimeDuration-to-date
363
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)
364
  nb. to quote 'the time components are then discarded'."
365
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
366
                        (decode-date date)
367
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day)
368
                          (decode-day-time-duration duration)
369
       ;; no need to pin the day, as duration does not change the year or month
370
       (multiple-value-bind (fraction second minute hour day month year)
371
                            (normalize-date-time-fragments (+ s-fraction d-fraction) (+ s-second d-second)
372
                                                           (+ s-minute d-minute) (+ s-hour d-hour)
373
                                                           (+ s-day d-day) s-month s-year)
374
         (declare (ignore fraction second minute hour))
375
         (spocq:make-date :minute s-minute :hour s-hour ; discard the result time fragments and reinstate the start zone
376
                          :day day :month month :year year :zone (spocq:date-zone date))))))
377
 
378
 (defmethod spocq.e:|+| ((date spocq:date) (duration spocq:year-month-duration))
379
   "Combine the 00:00:00 date with the given months and normalize.
380
  This requires deconstruction in order to effect the correct day/month normalization.
381
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-yearMonthDuration-to-date
382
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
383
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
384
                        (decode-date date)
385
     (declare (ignore s-fraction s-second))
386
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day d-month d-year)
387
                          (decode-year-month-duration duration)
388
       (declare (ignore d-fraction d-second d-minute d-hour d-day))
389
       (let ((e-month (+ s-month d-month))
390
             (e-year (+ s-year d-year)))
391
         (normalize-location-month-to-year e-month e-year)
392
         (let* ((end-of-month-p (= s-day (date:month-days s-month s-year)))
393
                (month-days (date:month-days e-month e-year))
394
                (e-day (if end-of-month-p month-days (min s-day month-days))))    ; pin the day
395
           (spocq:make-date :hour s-hour :minute s-minute
396
                            :day e-day :month e-month :year e-year :zone (spocq:date-zone date)))))))
397
 
398
 ;;; + commutes, - does not
399
 (defmethod spocq.e:|+| ((term1 spocq:duration) (term2 spocq:date))
400
   (spocq.e:|+| term2 term1))
401
 
402
 
403
 (defmethod spocq.e:|-| ((date spocq:date) (duration spocq:day-time-duration))
404
   "Combine the 00:00:00 date with the given time and normalize.
405
  This requires deconstruction in order to effect the correct day/month normalization.
406
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-dayTimeDuration-to-date
407
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
408
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
409
                        (decode-date date)
410
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day)
411
                          (decode-day-time-duration duration)
412
       ;; no need to pin the day, as duration does not change the year or month
413
       (multiple-value-bind (fraction second minute hour day month year)
414
                            (normalize-date-time-fragments (- s-fraction d-fraction)
415
                                                           (- s-second d-second)
416
                                                           (- s-minute d-minute) (- s-hour d-hour)
417
                                                           (- s-day d-day)
418
                                                           s-month s-year)
419
         (declare (ignore fraction second minute hour))
420
         (spocq:make-date :minute s-minute :hour s-hour ; discard the result time fragments and reinstate the start zone
421
                          :day day :month month :year year :zone (spocq:date-zone date))))))
422
 
423
 (defmethod spocq.e:|-| ((date spocq:date) (duration spocq:year-month-duration))
424
   "Combine the 00:00:00 date with the given months and normalize.
425
  This requires deconstruction in order to effect the correct day/month normalization.
426
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-yearMonthDuration-to-date
427
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
428
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
429
                        (decode-date date)
430
     (declare (ignore s-fraction s-second))
431
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day d-month d-year)
432
                          (decode-year-month-duration duration)
433
       (declare (ignore d-fraction d-second d-minute d-hour d-day))
434
       (let ((e-month (- s-month d-month))
435
             (e-year (- s-year d-year)))
436
         (normalize-location-month-to-year e-month e-year)
437
         (let* ((end-of-month-p (= s-day (date:month-days s-month s-year)))
438
                (month-days (date:month-days e-month e-year))
439
                (e-day (if end-of-month-p month-days (min s-day month-days))))     ; pin the day
440
           (spocq:make-date :hour s-hour :minute s-minute
441
                            :day e-day :month e-month :year e-year :zone (spocq:date-zone date)))))))
442
 
443
 
444
 (defmethod spocq.e:|-| ((term1 spocq:date) (term2 spocq:date))
445
   "Combine two dates based on their timeline locations. On one hand the XPath specification
446
  refers to the algorithm for adding durations, of which this should be an inverse, but
447
  as the result is in the dayTimeduration value domein, it is in seconds, which means
448
  that algorithms's logic for pinned days and month normalization has no relvance.
449
   first in the months domain, thn in the seconds domain
450
  with the intermediate step to pin the result day.
451
  This requires deconstruction in order to effect the correct day/month normalization.
452
  (see http://www.w3.org/TR/xpath-functions-30/#func-subtract-DateTimes
453
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
454
   (let ((timeline-difference (- (date-timeline-location term1) (date-timeline-location term2))))
455
     (spocq:make-day-time-duration :second-location timeline-difference)))
456
 
457
 
458
 (defmethod predicate-argument-type-error (operator (term1 spocq:date) (term2 t)  &optional (type (spocq.a:|datatype| term1)))
459
   (spocq.e:argument-type-error :operator operator :expected-type type :datum term2))
460
 
461
 (defmethod predicate-argument-type-error (operator (term1 t) (term2 spocq:date)  &optional (type (spocq.a:|datatype| term2)))
462
   (predicate-argument-type-error operator term2 term1 type))
463
 
464
 
465
 ;;; date-time
466
 
467
 (defun |fn|:|dateTime| (date time)
468
   "( ( xsd:date xsd:time ) xsd:dateTime )"
469
   (spocq.e::+ date time))
470
 
471
 (define-compiler-macro |fn|:|dateTime| (date time)
472
   (setf (variable-opacity (expression-variables date)) :transparent)
473
   (setf (variable-opacity (expression-variables time)) :transparent)
474
  `(spocq.e::+ ,date ,time))
475
 
476
 (defmacro |xsd|:|dateTime| (expression)
477
   "( ( (or xsd:string numeric) ) xsd:dateTime )"
478
   (setf (variable-opacity (expression-variables expression)) :transparent)
479
   `(spocq.e:date-time ,expression))
480
 
481
 (defgeneric spocq.e:date-time (object)
482
   (:documentation "Construct a date-time term respective the given argument.
483
   Permit as argument
484
   - iso-8601 format string
485
   - date
486
   - date-time
487
   - unix timestamp integer
488
   - float - of which just the integer component is converted")
489
   (:method ((object string))
490
     (let ((result (intern-term-aspects :literal object |xsd|:|dateTime| nil)))
491
       (typecase result
492
         (spocq:date-time result)
493
         (t (call-next-method)))))
494
   (:method ((object spocq:date-time))
495
     object)
496
   (:method ((object spocq:date))
497
     (multiple-value-bind (fraction second minute hour day month year)
498
                          (decode-date object)
499
       (declare (ignore hour minute second fraction))
500
       (spocq:make-date-time :year year :month month :day day
501
                             :fraction 0 :second 0 :minute 0 :hour 0)))
502
   (:method ((object integer))
503
     (timeline-location-date-time (* +timeline-units-per-second+ object)))
504
   (:method ((object real))
505
     (timeline-location-date-time (truncate (* +timeline-units-per-second+ object))))
506
   (:method ((object t))
507
     (invalid-argument-type |xsd|:|dateTime| object |xsd|:|dateTime|)))
508
 
509
 (macrolet ((def-xpath-date-time-accessor (xpath-op implementation-op)
510
              `(progn (defun ,xpath-op (term)
511
                        "( ( xsd:dateTime ) xsd:integer )"
512
                        (,implementation-op term))
513
                      (define-compiler-macro ,xpath-op (expression)
514
                        (setf (variable-opacity (expression-variables expression)) :transparent)
515
                        (list ',implementation-op expression)))))
516
   (def-xpath-date-time-accessor |fn|:|day-from-dateTime| spocq.e:day)
517
   (def-xpath-date-time-accessor |fn|:|hours-from-dateTime| spocq.e:hours)
518
   (def-xpath-date-time-accessor |fn|:|minutes-from-dateTime| spocq.e:minutes)
519
   (def-xpath-date-time-accessor |fn|:|month-from-dateTime| spocq.e:month)
520
   (def-xpath-date-time-accessor |fn|:|seconds-from-dateTime| spocq.e:seconds)
521
   (def-xpath-date-time-accessor |fn|:|timezone-from-dateTime| spocq.e:time-zone)
522
   (def-xpath-date-time-accessor |fn|:|year-from-dateTime| spocq.e:year))
523
 
524
 
525
 (defmethod spocq.e:same-term ((term1 spocq:date-time) (term2 spocq:date-time))
526
   "Compare the canonicalized term values. Strict term identity would require also that the zones match."
527
   (= (date-time-timeline-location term1) (date-time-timeline-location term2)))
528
 
529
 (defmethod spocq.e:= ((term1 spocq:date-time) (term2 spocq:date-time))
530
   "Compare the canonicalized term values."
531
   (= (date-time-timeline-location term1) (date-time-timeline-location term2)))
532
 
533
 (defmethod spocq.e:< ((term1 spocq:date-time) (term2 spocq:date-time))
534
   "Compare the canonicalized term values."
535
   (< (date-time-timeline-location term1) (date-time-timeline-location term2)))
536
 
537
 (defmethod spocq.e:<= ((term1 spocq:date-time) (term2 spocq:date-time))
538
   "Compare the canonicalized term values."
539
   (<= (date-time-timeline-location term1) (date-time-timeline-location term2)))
540
 
541
 
542
 
543
 (defmethod spocq.e:|+| ((date-time spocq:date-time) (duration spocq:day-time-duration))
544
   "Combine the date-time with the given time duration and normalize.
545
  This requires deconstruction in order to effect the correct day/month normalization.
546
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-dayTimeDuration-to-dateTime
547
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
548
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
549
                        (decode-date-time date-time)
550
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day)
551
                          (decode-day-time-duration duration)
552
       ;; no need to pin the day, as duration does not change the year or month
553
       (multiple-value-bind (fraction second minute hour day month year)
554
                            (normalize-date-time-fragments (+ s-fraction d-fraction) (+ s-second d-second)
555
                                                           (+ s-minute d-minute) (+ s-hour d-hour)
556
                                                           (+ s-day d-day)
557
                                                           s-month s-year)
558
         (spocq:make-date-time :fraction fraction :second second :minute minute :hour hour
559
                               :day day :month month :year year :zone (spocq:date-time-zone date-time))))))
560
 
561
 (defmethod spocq.e:|+| ((date-time spocq:date-time) (duration spocq:year-month-duration))
562
   "Combine the date-time with the given time duration and normalize.
563
  This requires deconstruction in order to effect the correct day/month normalization.
564
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-yearMonthDuration-to-dateTime
565
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
566
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
567
                        (decode-date-time date-time)
568
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day d-month d-year)
569
                          (decode-year-month-duration duration)
570
       (declare (ignore d-fraction d-second d-minute d-hour d-day)) ; a duration as no time zone offset
571
       (let ((e-month (+ s-month d-month))
572
             (e-year (+ s-year d-year)))
573
         (normalize-location-month-to-year e-month e-year)
574
         (let* ((end-of-month-p (= s-day (date:month-days s-month s-year)))
575
                (month-days (date:month-days e-month e-year))
576
                (e-day (if end-of-month-p month-days (min s-day month-days))))     ; pin the day
577
           (spocq:make-date-time :fraction s-fraction :second s-second :minute s-minute :hour s-hour
578
                                 :day e-day :month e-month :year e-year :zone (spocq:date-time-zone date-time)))))))
579
 
580
 ;;; + commutes, - does not
581
 (defmethod spocq.e:|+| ((term1 spocq:duration) (term2 spocq:date-time))
582
   (spocq.e:|+| term2 term1))
583
 
584
 
585
 (defmethod spocq.e:|-| ((date-time spocq:date-time) (duration spocq:day-time-duration))
586
   "Combine the 00:00:00 date with the given time and normalize.
587
  This requires deconstruction in order to effect the correct day/month normalization.
588
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-dayTimeDuration-to-date
589
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
590
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
591
                        (decode-date-time date-time)
592
     (multiple-value-bind (d-fraction d-second d-minute d-hour d-day)
593
                          (decode-day-time-duration duration)
594
       ;; no need to pin the day, as duration does not change the year or month
595
       (multiple-value-bind (fraction second minute hour day month year)
596
                            (normalize-date-time-fragments (- s-fraction d-fraction) (- s-second d-second)
597
                                                           (- s-minute d-minute) (- s-hour d-hour)
598
                                                           (- s-day d-day)
599
                                                           s-month s-year)
600
           (spocq:make-date-time :fraction fraction :second second :minute minute :hour hour
601
                                 :day day :month month :year year :zone (spocq:date-time-zone date-time))))))
602
 
603
 (defmethod spocq.e:|-| ((date-time spocq:date-time) (duration spocq:year-month-duration))
604
   "Combine the 00:00:00 date with the given months and normalize.
605
  This requires deconstruction in order to effect the correct day/month normalization.
606
  (see http://www.w3.org/TR/xpath-functions-30/#func-add-yearMonthDuration-to-date
607
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
608
   (multiple-value-bind (s-fraction s-second s-minute s-hour s-day s-month s-year)
609
                        (decode-date-time date-time)
610
     (multiple-value-bind (d-fragment d-second d-minute d-hour d-day d-month d-year)
611
                          (decode-year-month-duration duration)
612
       (declare (ignore d-fragment d-second d-minute d-hour d-day))
613
       (let ((e-month (- s-month d-month))
614
             (e-year (- s-year d-year)))
615
         (normalize-location-month-to-year e-month e-year)
616
         (let* ((end-of-month-p (= s-day (date:month-days s-month s-year)))
617
                (month-days (date:month-days e-month e-year))
618
                (e-day (if end-of-month-p month-days (min s-day month-days))))     ; pin the day
619
           (spocq:make-date-time :fraction s-fraction :second s-second :hour s-hour :minute s-minute
620
                                 :day e-day :month e-month :year e-year :zone (spocq:date-time-zone date-time)))))))
621
 
622
 
623
 (defmethod spocq.e:|-| ((term1 spocq:date-time) (term2 spocq:date-time))
624
   "Combine two full date-times basedon their timeline locations. On one hand the XPath specification
625
  refers to the algorithm for adding durations, of which this should be an inverse, but
626
  as the result is in the dayTimeduration value domein, it is in seconds, which means
627
  that algorithms's logic for pinned days and month normalization has no relvance.
628
   first in the months domain, thn in the seconds domain
629
  with the intermediate step to pin the result day.
630
  This requires deconstruction in order to effect the correct day/month normalization.
631
  (see http://www.w3.org/TR/xpath-functions-30/#func-subtract-DateTimes
632
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
633
   (let ((timeline-difference (- (date-time-timeline-location term1) (date-time-timeline-location term2))))
634
     (spocq:make-day-time-duration :second-location timeline-difference)))
635
                               
636
 
637
 
638
 (defmethod predicate-argument-type-error (operator (term1 spocq:date-time) (term2 t)  &optional (type (spocq.a:|datatype| term1)))
639
   (spocq.e:argument-type-error :operator operator :expected-type type :datum term2))
640
 
641
 (defmethod predicate-argument-type-error (operator (term1 t) (term2 spocq:date-time)  &optional (type (spocq.a:|datatype| term2)))
642
   (predicate-argument-type-error operator term2 term1 type))
643
 
644
 
645
 
646
 ;;; day-time-duration
647
 
648
 (defmacro |xsd|:|dayTimeDuration| (expression)
649
   "( ( (or xsd:string numeric) ) xsd:dayTimeDuration )"
650
   (setf (variable-opacity (expression-variables expression)) :transparent)
651
   `(spocq.e:day-time-duration ,expression))
652
 
653
 (defgeneric spocq.e:day-time-duration (object)
654
   (:method ((object string))
655
     (let ((result (intern-term-aspects :literal object |xsd|:|dayTimeDuration| nil)))
656
       (typecase result
657
         (spocq:day-time-duration result)
658
         (t (call-next-method)))))
659
   (:method ((object spocq:day-time-duration))
660
     object)
661
   (:method ((object spocq:temporal))
662
     (make-day-time-duration 0 0 0 0 0))
663
 
664
   (:method ((object integer))
665
     (timeline-location-day-time-duration (* +timeline-units-per-second+ object)))
666
   (:method ((object real))
667
     (timeline-location-day-time-duration (truncate (* +timeline-units-per-second+ object))))
668
   (:method ((object t))
669
     (invalid-argument-type |xsd|:|dayTimeDuration| object |xsd|:|dayTimeDuration|)))
670
 
671
 
672
 (defmethod spocq.e:same-term ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
673
   "Compare the canonicalized term values. Strict term identity would require also that the zones match."
674
   (= (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
675
 
676
 (defmethod spocq.e:< ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
677
     (< (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
678
 
679
 (defmethod spocq.e:<= ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
680
     (<= (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
681
 
682
 (defmethod spocq.e:= ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
683
     (= (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
684
 
685
 (defmethod spocq.e:= ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
686
   "Compare the canonicalized term values."
687
   (= (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
688
 
689
 (defmethod spocq.e:<= ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
690
   "Compare the canonicalized term values."
691
   (<= (day-time-duration-second-location term1) (day-time-duration-second-location term2)))
692
 
693
 
694
 (defmethod spocq.e:+ ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
695
   (spocq:make-day-time-duration :second-location (+ (day-time-duration-second-location term1)
696
                                                     (day-time-duration-second-location term2))
697
                                 :month-location 0))
698
 
699
 (defmethod spocq.e:- ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
700
   (spocq:make-day-time-duration :second-location (- (day-time-duration-second-location term1)
701
                                                     (day-time-duration-second-location term2))
702
                                 :month-location 0))
703
 
704
 (defmethod spocq.e:* ((term1 spocq:day-time-duration) (term2 number))
705
   (spocq:make-day-time-duration :second-location (round (* (day-time-duration-second-location term1)
706
                                                            term2))
707
                                 :month-location 0))
708
 
709
 (defmethod spocq.e:* ((term1 number) (term2 spocq:day-time-duration))
710
   (spocq:make-day-time-duration :second-location (round (* (day-time-duration-second-location term2)
711
                                                            term1))
712
                                 :month-location 0))
713
 
714
 (defmethod spocq.e:/ ((term1 spocq:day-time-duration) (term2 number))
715
   (spocq:make-day-time-duration :second-location (round (/ (day-time-duration-second-location term1)
716
                                                              term2))
717
                                 :month-location 0))
718
 
719
 (defmethod spocq.e:/ ((term1 spocq:day-time-duration) (term2 spocq:day-time-duration))
720
   (/ (day-time-duration-second-location term1)
721
      (day-time-duration-second-location term2)))
722
 
723
 
724
 
725
 (defmethod predicate-argument-type-error (operator (term1 spocq:day-time-duration) (term2 t)  &optional (type (spocq.a:|datatype| term1)))
726
   (spocq.e:argument-type-error :operator operator :expected-type type :datum term2))
727
 
728
 (defmethod predicate-argument-type-error (operator (term1 t) (term2 spocq:day-time-duration)  &optional (type (spocq.a:|datatype| term2)))
729
   (predicate-argument-type-error operator term2 term1 type))
730
 
731
 
732
 ;;; duration
733
 
734
 (defmacro |xsd|:|duration| (expression)
735
   "( ( (or xsd:string numeric) ) xsd:duration )"
736
   (setf (variable-opacity (expression-variables expression)) :transparent)
737
   `(spocq.e:duration ,expression))
738
 
739
 (defgeneric spocq.e:duration (object)
740
   (:method ((object string))
741
     (let ((result (intern-term-aspects :literal object |xsd|:|duration| nil)))
742
       (typecase result
743
         (spocq:duration result)
744
         (t (call-next-method)))))
745
   (:method ((object spocq:duration))
746
     object)
747
   (:method ((object spocq:day-time-duration))
748
     (spocq:make-duration :second-location (day-time-duration-second-location object)))
749
   (:method ((object spocq:year-month-duration))
750
     (spocq:make-duration :month-location (year-month-duration-month-location object)))
751
 
752
   (:method ((object integer))
753
     (timeline-location-duration (* +timeline-units-per-second+ object)))
754
   (:method ((object real))
755
     (timeline-location-duration (truncate (* +timeline-units-per-second+ object))))
756
 
757
   (:method ((object t))
758
     (invalid-argument-type |xsd|:|duration| object |xsd|:|duration|)))
759
 
760
 
761
 (macrolet ((def-xpath-duration-accessor (xpath-op implementation-op documentation)
762
              `(progn (defun ,xpath-op (term)
763
                        ,documentation
764
                        (,implementation-op term))
765
                      (define-compiler-macro ,xpath-op (expression)
766
                        (setf (variable-opacity (expression-variables expression)) :transparent)
767
                        (list ',implementation-op expression)))))
768
   (def-xpath-duration-accessor |fn|:|seconds-from-duration| spocq.e:seconds
769
     "( ( xsd:duration) xsd:rational )
770
      Return the normalized second fragment from a duration.
771
      For a yearMonth duration the result is constantly zero.
772
      Available also as the SPARQL operator SECONDS.")
773
   (def-xpath-duration-accessor |fn|:|minutes-from-duration| spocq.e:minutes
774
     "( ( xsd:duration) xsd:integer )
775
      Return the normalized minute fragment from a duration.
776
      For a yearMonth duration the result is constantly zero.
777
      Available also as the SPARQL operator MINUTES.")
778
   (def-xpath-duration-accessor |fn|:|hours-from-duration| spocq.e:hours
779
     "( ( xsd:duration) xsd:integer )
780
      Return the normalized hour fragment from a duration.
781
      For a yearMonth duration the result is constantly zero.
782
      Available also as the SPARQL operator HOURS.")
783
   (def-xpath-duration-accessor |fn|:|days-from-duration| spocq.e:day
784
     "( ( xsd:duration) xsd:integer )
785
      Return the normalized  day fragment from a duration.
786
      For a yearMonth duration the result is constantly zero.
787
      Available also as the SPARQL operator DAY.")
788
   (def-xpath-duration-accessor |fn|:|months-from-duration| spocq.e:month
789
     "( ( xsd:duration) xsd:integer )
790
      Return the normalized month fragment from a duration.
791
      For a dayTimeMonth duration the result is constantly zero.
792
      Available also as the SPARQL operator MONTH.")
793
   (def-xpath-duration-accessor |fn|:|years-from-duration| spocq.e:year
794
     "( ( xsd:duration) xsd:integer )
795
      Return the normalized year fragment from a duration.
796
      For a dayTimeMonth duration the result is constantly zero.
797
      Available also as the SPARQL operator YEAR."))
798
 
799
 (macrolet ((def-xpath-duration-accessor (xpath-op implementation-op documentation)
800
              `(progn (defun ,xpath-op (term)
801
                        ,documentation
802
                        (,implementation-op term))
803
                      (define-compiler-macro ,xpath-op (expression)
804
                        (setf (variable-opacity (expression-variables expression)) :transparent)
805
                        (list ',implementation-op expression)))))
806
   (def-xpath-duration-accessor |fn|:|duration-in-seconds| spocq.e::duration-in-seconds
807
     "( ( xsd:dayTimeDuration ) xsd:rational )
808
      Return the total duration in seconds as a function of all fragments.")
809
   (def-xpath-duration-accessor |fn|:|duration-in-minutes| spocq.e::duration-in-minutes
810
     "( ( xsd:dayTimeDuration ) xsd:rational )
811
      Return the total duration in minutes as a function of all fragments.")
812
   (def-xpath-duration-accessor |fn|:|duration-in-hours| spocq.e::duration-in-hours
813
     "( ( xsd:dayTimeDuration ) xsd:rational )
814
      Return the total duration in hours as a function of all fragments.")
815
   (def-xpath-duration-accessor |fn|:|duration-in-days| spocq.e::duration-in-days
816
     "( ( xsd:dayTimeDuration ) xsd:rational )
817
      Return the total duration in days as a function of all fragments.")
818
   (def-xpath-duration-accessor |fn|:|duration-in-months| spocq.e::duration-in-months
819
     "( ( xsd:yearMonthDuration ) xsd:rational )
820
      Return the total duration in months as a function of all fragments.")
821
   (def-xpath-duration-accessor |fn|:|duration-in-years| spocq.e::duration-in-years
822
     "( ( xsd:yearMonthDuration ) xsd:rational )
823
      Return the total duration in minutes as a function of all fragments."))
824
 
825
 (defgeneric spocq.e::duration-in-seconds (object)
826
   (:method ((duration spocq:day-time-duration))
827
     (/ (day-time-duration-second-location duration)
828
        +timeline-units-per-second+))
829
   (:method ((duration spocq:year-month-duration))
830
     0)
831
   (:method ((duration string))
832
     (cond ((parse-|PnDTnHnMnS| duration nil)
833
            (/ (day-time-duration-second-location (|PnDTnHnMnS| duration))
834
               +timeline-units-per-second+))
835
           ((parse-|PnYnM| duration nil)
836
            0)
837
           (t
838
            (/ (duration-second-location (|PnYnMnDTnHnMnS| duration))
839
               +timeline-units-per-second+)))))
840
 
841
 (defun spocq.e::duration-in-minutes (object)
842
   (/ (spocq.e::duration-in-seconds object) 60))
843
 
844
 (defun spocq.e::duration-in-hours (object)
845
   (/ (spocq.e::duration-in-seconds object) #.(* 60 60)))
846
 
847
 (defun spocq.e::duration-in-days (object)
848
   (/ (spocq.e::duration-in-seconds object) #.(* 24 60 60)))
849
 
850
 (defgeneric spocq.e::duration-in-months (object)
851
   (:method ((duration spocq:day-time-duration))
852
     0)
853
   (:method ((duration spocq:year-month-duration))
854
     (year-month-duration-month-location duration))
855
   (:method ((duration string))
856
     (cond ((parse-|PnYnM| duration nil)
857
            (year-month-duration-month-location (|PnYnM| duration)))
858
           ((parse-|PnDTnHnMnS| duration nil)
859
            0)
860
           (t
861
            (duration-month-location (|PnYnMnDTnHnMnS| duration))))))
862
 
863
 (defun spocq.e::duration-in-years (object)
864
   (/ (spocq.e::duration-in-months object) 12))
865
 
866
 
867
 
868
 ;;; (spocq.a:- (spocq.a:|now|) (spocq:make-date-time :universal-time (- (get-universal-time) 3600)))
869
 
870
 (defmethod spocq.e:= ((term1 spocq:duration) (term2 spocq:duration))
871
   "Given any combination of durations - whether the abstract type or different concrete types,
872
  compare the respective second and month locations."
873
   (and (= (duration-second-location term1) (duration-second-location term2))
874
        (= (duration-month-location term1) (duration-month-location term2))))
875
 
876
 (defmethod spocq.e:< ((term1 spocq:duration) (term2 spocq:duration))
877
   nil)
878
 
879
 (defmethod spocq.e:<= ((term1 spocq:duration) (term2 spocq:duration))
880
   nil)
881
 
882
 
883
 
884
 ;;;
885
 ;;; gDay
886
 
887
 (defmacro |xsd|:|gDay| (expression)
888
   "( ( (or xsd:string numeric) ) xsd:gDay )"
889
   (setf (variable-opacity (expression-variables expression)) :transparent)
890
   `(spocq.e:g-day ,expression))
891
 
892
 (defgeneric spocq.e:g-day (object)
893
   (:method ((object string))
894
     (let ((result (intern-term-aspects :literal object |xsd|:|gDay| nil)))
895
       (typecase result
896
         (spocq:g-day result)
897
         (t (call-next-method)))))
898
   (:method ((object spocq:g-day))
899
     object)
900
   (:method ((object spocq:date))
901
     (make-g-day (date-day object) (spocq:date-zone object)))
902
   (:method ((object spocq:date-time))
903
     (make-g-day (date-time-day object) (spocq:date-time-zone object)))
904
   (:method ((object integer))
905
     (if (<= 1 object 31)
906
       (make-g-day object)
907
       (make-g-day (timeline-location-day object))))
908
   (:method ((day real))
909
     (make-g-day (round day)))
910
   (:method ((object t))
911
     (invalid-argument-type |xsd|:|gDay| object |xsd|:|gDay|)))
912
 
913
 (defmethod spocq.e:= ((term1 spocq:g-day) (term2 spocq:g-day))
914
   ;; zone equality is stipulated in the recommendation
915
   ;; http://www.w3.org/TR/xpath-functions-30/#func-gDay-equal
916
   ;; require comparable zones and equality to the minute to allow for zone offset
917
   (and (zones-comparable-p (g-day-zone term1) (g-day-zone term2))
918
        (= (spocq:g-day-day term1) (spocq:g-day-day term2))
919
        (= (spocq:g-day-hour term1) (spocq:g-day-hour term2))
920
        (= (spocq:g-day-minute term1) (spocq:g-day-minute term2))))
921
 
922
 ;;; no  absolute ordering operators (see note at head)
923
 (defmethod spocq.e:< ((term1 spocq:g-day) (term2 spocq:g-day))
924
   (< (spocq:g-day-day term1) (spocq:g-day-day term2)))
925
 (defmethod spocq.e:<= ((term1 spocq:g-day) (term2 spocq:g-day))
926
   (or (spocq.e:= term1 term2)
927
       (spocq.e:< term1 term2)))
928
 
929
 
930
 (defmacro |xsd|:|gMonth| (expression)
931
   "( ( (or xsd:string numeric) ) xsd:gMonth )"
932
   (setf (variable-opacity (expression-variables expression)) :transparent)
933
   `(spocq.e:g-month ,expression))
934
 
935
 (defgeneric spocq.e:g-month (object)
936
   (:method ((object string))
937
     (let ((result (intern-term-aspects :literal object |xsd|:|gMonth| nil)))
938
       (typecase result
939
         (spocq:g-month result)
940
         (t (call-next-method)))))
941
   (:method ((object spocq:g-month))
942
     object)
943
   (:method ((object spocq:date))
944
     (make-g-month (date-month object) (spocq:date-zone object)))
945
   (:method ((object spocq:date-time))
946
     (make-g-month (date-time-month object) (spocq:date-time-zone object)))
947
   (:method ((object integer))
948
     (if (<= 1 object 12)
949
       (make-g-month object)
950
       (make-g-month (timeline-location-month object))))
951
   (:method ((object real))
952
     (make-g-month (round object)))
953
   (:method ((object t))
954
     (invalid-argument-type |xsd|:|gMonth| object |xsd|:|gMonth|)))
955
 
956
 (defmethod spocq.e:= ((term1 spocq:g-month) (term2 spocq:g-month))
957
   ;; require comparable zones and equality to the minute to allow for zone offset
958
   (and (zones-comparable-p (g-month-zone term1) (g-month-zone term2))
959
        (= (spocq:g-month-month term1) (spocq:g-month-month term2))
960
        (= (spocq:g-month-day term1) (spocq:g-month-day term2))
961
        (= (spocq:g-month-hour term1) (spocq:g-month-hour term2))
962
        (= (spocq:g-month-minute term1) (spocq:g-month-minute term2))))
963
 
964
 ;;; no  absolute ordering operators (see note at head)
965
 (defmethod spocq.e:< ((term1 spocq:g-month) (term2 spocq:g-month))
966
   (< (spocq:g-month-month term1) (spocq:g-month-month term2)))
967
 (defmethod spocq.e:<= ((term1 spocq:g-month) (term2 spocq:g-month))
968
   (or (spocq.e:= term1 term2)
969
       (spocq.e:< term1 term2)))
970
 
971
 
972
 (defmacro |xsd|:|gMonthDay| (expression)
973
   "( ( (or xsd:string numeric) ) xsd:gMonthDay )"
974
   (setf (variable-opacity (expression-variables expression)) :transparent)
975
   `(spocq.e:g-month-day ,expression))
976
 
977
 (defgeneric spocq.e:g-month-day (object)
978
   (:method ((object string))
979
     (let ((result (intern-term-aspects :literal object |xsd|:|gMonthDay| nil)))
980
       (typecase result
981
         (spocq:g-month-day result)
982
         (t (call-next-method)))))
983
   (:method ((object spocq:g-month-day))
984
     object)
985
   (:method ((object spocq:date))
986
     (make-g-month-day (date-day object) (spocq:date-month object) (spocq:date-zone object)))
987
   (:method ((object spocq:date-time))
988
     (make-g-month-day (date-time-day object) (spocq:date-time-month object) (spocq:date-time-zone object)))
989
   (:method ((object integer))
990
     (or (and (<= 1 object 1231)
991
              (multiple-value-bind (month day) (truncate object 100)
992
                (when (and (<= 1 month 12) (<= 1 day (date:month-days month)))
993
                  (make-g-month-day day month))))
994
         (make-g-month-day (timeline-location-day object) (timeline-location-month object))))
995
   (:method ((object real))
996
     (spocq.e:g-month-day (round object)))
997
   (:method ((object t))
998
     (invalid-argument-type |xsd|:|gMonthDay| object |xsd|:|gMonthDay|)))
999
 
1000
 (defmethod spocq.e:= ((term1 spocq:g-month-day) (term2 spocq:g-month-day))
1001
   ;; require both or neither to be zoned
1002
   ;; compare down to the minute to recognize zone offset
1003
   (and (zones-comparable-p (spocq:g-month-day-zone term1) (spocq:g-month-day-zone term2))
1004
        (= (spocq:g-month-day-month term1) (spocq:g-month-day-month term2))
1005
        (= (spocq:g-month-day-day term1) (spocq:g-month-day-day term2))
1006
        (= (spocq:g-month-day-hour term1) (spocq:g-month-day-hour term2))
1007
        (= (spocq:g-month-day-minute term1) (spocq:g-month-day-minute term2))))
1008
 
1009
 ;;; no  absolute ordering operators (see note at head)
1010
 (defmethod spocq.e:< ((term1 spocq:g-month-day) (term2 spocq:g-month-day))
1011
   (if (= (spocq:g-month-day-month term1) (spocq:g-month-day-month term2))
1012
       (< (spocq:g-month-day-day term1) (spocq:g-month-day-day term2))
1013
       (< (spocq:g-month-day-month term1) (spocq:g-month-day-month term2))))
1014
 (defmethod spocq.e:<= ((term1 spocq:g-month-day) (term2 spocq:g-month-day))
1015
   (or (spocq.e:= term1 term2)
1016
       (spocq.e:< term1 term2)))
1017
 
1018
 
1019
 
1020
 ;;; g-year
1021
 
1022
 (defmacro |xsd|:|gYear| (expression)
1023
   "( ( (or xsd:string numeric) ) xsd:gYear )"
1024
   (setf (variable-opacity (expression-variables expression)) :transparent)
1025
   `(spocq.e:g-year ,expression))
1026
 
1027
 (defgeneric spocq.e:g-year (object)
1028
   (:method ((object string))
1029
     (let ((result (intern-term-aspects :literal object |xsd|:|gYear| nil)))
1030
       (typecase result
1031
         (spocq:g-year result)
1032
         (t (call-next-method)))))
1033
   (:method ((object spocq:g-year))
1034
     object)
1035
   (:method ((object spocq:date))
1036
     (make-g-year (date-year object) (spocq:date-zone object)))
1037
   (:method ((object spocq:date-time))
1038
     (make-g-year (date-time-year object) (spocq:date-time-zone object)))
1039
   (:method ((object integer))
1040
     (if (<= 1 object 9999)
1041
       (make-g-year object)
1042
       (make-g-year (timeline-location-year object))))
1043
   (:method ((object real))
1044
     (make-g-year (round object)))
1045
   (:method ((object t))
1046
     (invalid-argument-type |xsd|:|gYear| object |xsd|:|gYear|)))
1047
 
1048
 (defmethod spocq.e:= ((term1 spocq:g-year) (term2 spocq:g-year))
1049
   (and (zones-comparable-p (g-year-zone term1) (g-year-zone term2))
1050
        (= (spocq:g-year-year term1) (spocq:g-year-year term2))
1051
        (= (spocq:g-year-month term1) (spocq:g-year-month term2))
1052
        (= (spocq:g-year-day term1) (spocq:g-year-day term2))
1053
        (= (spocq:g-year-hour term1) (spocq:g-year-hour term2))
1054
        (= (spocq:g-year-minute term1) (spocq:g-year-minute term2))))
1055
 
1056
 ;;;; no   absolute ordering operators (see note at head)
1057
 (defmethod spocq.e:< ((term1 spocq:g-year) (term2 spocq:g-year))
1058
   (< (spocq:g-year-year term1) (spocq:g-year-year term2)))
1059
 (defmethod spocq.e:<= ((term1 spocq:g-year) (term2 spocq:g-year))
1060
   (or (spocq.e:= term1 term2)
1061
       (spocq.e:< term1 term2)))
1062
 
1063
 
1064
 ;;; g-year-month
1065
 
1066
 (defmacro |xsd|:|gYearMonth| (expression)
1067
   "( ( (or xsd:string numeric) ) xsd:gYearMonth )"
1068
   (setf (variable-opacity (expression-variables expression)) :transparent)
1069
   `(spocq.e:g-year-month ,expression))
1070
 
1071
 (defgeneric spocq.e:g-year-month (object)
1072
   (:method ((object string))
1073
     (let ((result (intern-term-aspects :literal object |xsd|:|gYearMonth| nil)))
1074
       (typecase result
1075
         (spocq:g-year-month result)
1076
         (t (call-next-method)))))
1077
   (:method ((object spocq:g-year-month))
1078
     object)
1079
   (:method ((object spocq:date))
1080
     (make-g-year-month (date-month object) (spocq:date-year object) (spocq:date-zone object)))
1081
   (:method ((object spocq:date-time))
1082
     (make-g-year-month (date-time-month object) (spocq:date-time-year object) (spocq:date-time-zone object)))
1083
   (:method ((object integer))
1084
     (or (and (<= 1 object 999912)
1085
              (let ((year (floor object 100))
1086
                    (month (mod object 100)))
1087
                (when (and (<= 1 month 12) (<= 1 year 9999))
1088
                  (make-g-year-month month year))))
1089
         (make-g-year-month (timeline-location-month object) (timeline-location-year object))))
1090
   (:method ((object real))
1091
     (spocq.e:g-year-month (round object)))
1092
   (:method ((object t))
1093
     (invalid-argument-type |xsd|:|gYearMonth| object |xsd|:|gYearMonth|)))
1094
 
1095
 (defmethod spocq.e:= ((term1 spocq:g-year-month) (term2 spocq:g-year-month))
1096
   (and (zones-comparable-p (g-year-month-zone term1) (g-year-month-zone term2))
1097
        (= (spocq:g-year-month-year term1) (spocq:g-year-month-year term2))
1098
        (= (spocq:g-year-month-month term1) (spocq:g-year-month-month term2))
1099
        (= (spocq:g-year-month-day term1) (spocq:g-year-month-day term2))
1100
        (= (spocq:g-year-month-hour term1) (spocq:g-year-month-hour term2))
1101
        (= (spocq:g-year-month-minute term1) (spocq:g-year-month-minute term2))))
1102
 
1103
 ;;; no  absolute ordering operators (see note at head)
1104
 (defmethod spocq.e:< ((term1 spocq:g-year-month) (term2 spocq:g-year-month))
1105
   (if (= (spocq:g-year-month-year term1) (spocq:g-year-month-year term2))
1106
       (< (spocq:g-year-month-month term1) (spocq:g-year-month-month term2))
1107
       (< (spocq:g-year-month-year term1) (spocq:g-year-month-year term2))))
1108
 (defmethod spocq.e:<= ((term1 spocq:g-year-month) (term2 spocq:g-year-month))
1109
   (or (spocq.e:= term1 term2)
1110
       (spocq.e:< term1 term2)))
1111
       
1112
 
1113
 
1114
 
1115
 ;;; time
1116
 
1117
 (defmacro |xsd|:|time| (expression)
1118
   "( ( (or xsd:string numeric) ) xsd:time )"
1119
   (setf (variable-opacity (expression-variables expression)) :transparent)
1120
   `(spocq.e:time ,expression))
1121
 
1122
 (defgeneric spocq.e:time (object)
1123
   (:method ((object string))
1124
     (let ((result (intern-term-aspects :literal object |xsd|:|time| nil)))
1125
       (typecase result
1126
         (spocq:time result)
1127
         (t (call-next-method)))))
1128
   (:method ((object spocq:time))
1129
     object)
1130
   (:method ((object spocq:date))
1131
     (spocq:make-time :hour 0 :minute 0 :second 0))
1132
   (:method ((object spocq:date-time))
1133
     (multiple-value-bind (fraction second minute hour)
1134
                          (decode-date-time object)
1135
       (spocq:make-time :second second :minute minute :hour hour
1136
                        :fraction fraction)))
1137
   (:method ((object integer))
1138
     (timeline-location-time (* +timeline-units-per-second+ object)))
1139
   (:method ((object real))
1140
     (timeline-location-time (truncate (* +timeline-units-per-second+ object))))
1141
   (:method ((object t))
1142
     (invalid-argument-type |xsd|:|time| object |xsd|:|time|)))
1143
 
1144
 (macrolet ((def-xpath-time-accessor (xpath-op implementation-op)
1145
              `(progn (defun ,xpath-op (term)
1146
                        "( ( xsd:time ) xsd:integer )"
1147
                        (,implementation-op term))
1148
                      (define-compiler-macro ,xpath-op (expression)
1149
                        (setf (variable-opacity (expression-variables expression)) :transparent)
1150
                        (list ',implementation-op expression)))))
1151
   (def-xpath-time-accessor |fn|:|hours-from-time| spocq.e:hours)
1152
   (def-xpath-time-accessor |fn|:|minutes-from-time| spocq.e:minutes)
1153
   (def-xpath-time-accessor |fn|:|seconds-from-time| spocq.e:seconds)
1154
   (def-xpath-time-accessor |fn|:|timezone-from-time| spocq.e:time-zone))
1155
 
1156
 
1157
 (defmethod spocq.e:same-term ((term1 spocq:time) (term2 spocq:time))
1158
   "Compare the canonicalized term values. Strict term identity would require also that the zones match."
1159
   (= (time-timeline-location term1) (time-timeline-location term2)))
1160
 
1161
 (defmethod spocq.e:= ((term1 spocq:time) (term2 spocq:time))
1162
   "Compare the canonicalized term values."
1163
   (= (time-timeline-location term1) (time-timeline-location term2)))
1164
 
1165
 (defmethod spocq.e:< ((term1 spocq:time) (term2 spocq:time))
1166
   "Compare the canonicalized term values."
1167
   (< (time-timeline-location term1) (time-timeline-location term2)))
1168
 
1169
 (defmethod spocq.e:<= ((term1 spocq:time) (term2 spocq:time))
1170
   "Compare the canonicalized term values."
1171
   (<= (time-timeline-location term1) (time-timeline-location term2)))
1172
 
1173
 
1174
 ;;; should there be a distinct operator for the other order which does not truncate
1175
 ;;; https://www.w3.org/TR/xpath-functions-31/#func-add-dayTimeDuration-to-time
1176
 (defmethod spocq.e:|+| ((term1 spocq:time) (term2 spocq:day-time-duration))
1177
   (setf term2 (spocq::copy-day-time-duration term2))
1178
   (setf (spocq::day-time-duration-day term2) 0
1179
         (spocq:day-time-duration-second-location term2) nil)
1180
   (let* ((time-location (time-second-location term1))
1181
          (duration-location (day-time-duration-second-location term2))
1182
          (result-location (+ time-location duration-location)))
1183
     ;; use the full second-fraction value and allow normalization
1184
     (make-time result-location 0 0 0)))
1185
 
1186
 (defmethod spocq.e:|+| ((term1 spocq:day-time-duration) (term2 spocq:time))
1187
   ;(spocq.e:|+| term2 term1)
1188
   (let* ((time-location (time-second-location term1))
1189
          (duration-location (day-time-duration-second-location term2))
1190
          (result-location (+ time-location duration-location)))
1191
     ;; use the full second-fraction value and allow normalization
1192
     (spocq:make-day-time-duration :second-location result-location)))
1193
 
1194
 (defmethod spocq.e:|-| ((term1 spocq:time) (term2 spocq:time))
1195
   "Combine two full date-times basedon their timeline locations. On one hand the XPath specification
1196
  refers to the algorithm for adding durations, of which this should be an inverse, but
1197
  as the result is in the dayTimeduration value domein, it is in seconds, which means
1198
  that algorithms's logic for pinned days and month normalization has no relvance.
1199
   first in the months domain, thn in the seconds domain
1200
  with the intermediate step to pin the result day.
1201
  This requires deconstruction in order to effect the correct day/month normalization.
1202
  (see http://www.w3.org/TR/xpath-functions-30/#func-subtract-DateTimes
1203
   and http://www.w3.org/TR/xmlschema-2/#adding-durations-to-dateTimes)"
1204
   (let ((timeline-difference (- (date-time-timeline-location term1) (date-time-timeline-location term2))))
1205
     (spocq:make-day-time-duration :second-location timeline-difference)))
1206
 
1207
 ;;; should there be a distinct operator for the other order which does not truncate
1208
 ;;; https://www.w3.org/TR/xpath-functions-31/#func-add-dayTimeDuration-to-time
1209
 (defmethod spocq.e:|-| ((term1 spocq:time) (term2 spocq:day-time-duration))
1210
   (setf term2 (spocq::copy-day-time-duration term2))
1211
   (setf (spocq::day-time-duration-day term2) 0
1212
         (spocq:day-time-duration-second-location term2) nil)
1213
   (let* ((time-location (time-second-location term1))
1214
          (duration-location (day-time-duration-second-location term2))
1215
          (result-location (- time-location duration-location)))
1216
     ;; use the full second-fraction value and allow normalization
1217
     (make-time result-location 0 0 0)))
1218
 
1219
 (defmethod spocq.e:|-| ((term1 spocq:day-time-duration) (term2 spocq:time))
1220
   (let* ((time-location (time-second-location term1))
1221
          (duration-location (day-time-duration-second-location term2))
1222
          (result-location (- time-location duration-location)))
1223
     ;; use the full second-fraction value and allow normalization
1224
     (spocq:make-day-time-duration :second-location result-location)))
1225
 
1226
 (defmethod predicate-argument-type-error (operator (term1 spocq:time) (term2 t)  &optional (type (spocq.a:|datatype| term1)))
1227
   (spocq.e:argument-type-error :operator operator :expected-type type :datum term2))
1228
 
1229
 (defmethod predicate-argument-type-error (operator (term1 t) (term2 spocq:time)  &optional (type (spocq.a:|datatype| term2)))
1230
   (predicate-argument-type-error operator term2 term1 type))
1231
 
1232
 
1233
 
1234
 ;;; year-month-duration
1235
 
1236
 (defmacro |xsd|:|yearMonthDuration| (expression)
1237
   "( ( (or xsd:string numeric) ) xsd:yearMonthDuration )"
1238
   (setf (variable-opacity (expression-variables expression)) :transparent)
1239
   `(spocq.e:year-month-duration ,expression))
1240
 
1241
 (defgeneric spocq.e:year-month-duration (object)
1242
   (:method ((object string))
1243
     (let ((result (intern-term-aspects :literal object |xsd|:|yearMonthDuration| nil)))
1244
       (typecase result
1245
         (spocq:year-month-duration result)
1246
         (t (call-next-method)))))
1247
   (:method ((object spocq:year-month-duration))
1248
     object)
1249
   (:method ((object spocq:temporal))
1250
     (make-year-month-duration 0 0))
1251
 
1252
   (:method ((object integer))
1253
     (timeline-location-year-month-duration (* +timeline-units-per-second+ object)))
1254
   (:method ((object real))
1255
     (timeline-location-year-month-duration (truncate (* +timeline-units-per-second+ object))))
1256
   (:method ((object t))
1257
     (invalid-argument-type |xsd|:|dayTimeDuration| object |xsd|:|dayTimeDuration|)))
1258
 
1259
 
1260
 (defmethod spocq.e:same-term ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1261
   "Compare the canonicalized term values. Strict term identity would require also that the zones match."
1262
   (= (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1263
 
1264
 (defmethod spocq.e:< ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1265
     (< (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1266
 
1267
 (defmethod spocq.e:<= ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1268
     (<= (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1269
 
1270
 (defmethod spocq.e:= ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1271
     (= (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1272
 
1273
 (defmethod spocq.e:= ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1274
   "Compare the canonicalized term values."
1275
   (= (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1276
 
1277
 (defmethod spocq.e:<= ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1278
   "Compare the canonicalized term values."
1279
   (<= (year-month-duration-month-location term1) (year-month-duration-month-location term2)))
1280
 
1281
 
1282
 (defmethod spocq.e:+ ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1283
   (spocq:make-year-month-duration :month-location (+ (year-month-duration-month-location term1)
1284
                                                      (year-month-duration-month-location term2))
1285
                                   :second-location 0))
1286
 
1287
 (defmethod spocq.e:- ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1288
   (spocq:make-year-month-duration :month-location (- (year-month-duration-month-location term1)
1289
                                                      (year-month-duration-month-location term2))
1290
                                   :second-location 0))
1291
 
1292
 (defmethod spocq.e:* ((term1 spocq:year-month-duration) (term2 number))
1293
   (spocq:make-year-month-duration :month-location (round (* (year-month-duration-month-location term1)
1294
                                                             term2))
1295
                                   :second-location 0))
1296
 
1297
 (defmethod spocq.e:* ((term1 number) (term2 spocq:year-month-duration))
1298
   (spocq:make-year-month-duration :month-location (round (* (year-month-duration-month-location term2)
1299
                                                             term1))
1300
                                   :second-location 0))
1301
 
1302
 (defmethod spocq.e:/ ((term1 spocq:year-month-duration) (term2 number))
1303
   (spocq:make-year-month-duration :month-location (round (/ (year-month-duration-month-location term1)
1304
                                                             term2))
1305
                                   :second-location 0))
1306
 
1307
 (defmethod spocq.e:/ ((term1 spocq:year-month-duration) (term2 spocq:year-month-duration))
1308
   (/ (year-month-duration-month-location term1)
1309
      (year-month-duration-month-location term2)))
1310
 
1311
 
1312
 (defmethod predicate-argument-type-error (operator (term1 spocq:year-month-duration) (term2 t)  &optional (type (spocq.a:|datatype| term1)))
1313
   (spocq.e:argument-type-error :operator operator :expected-type type :datum term2))
1314
 
1315
 (defmethod predicate-argument-type-error (operator (term1 t) (term2 spocq:year-month-duration)  &optional (type (spocq.a:|datatype| term2)))
1316
   (predicate-argument-type-error operator term2 term1 type))
1317
 
1318
 
1319
 
1320
 #|
1321
 ;;; temporal-proximity-by-exclusion-nex-1
1322
 
1323
 (setq *algebra-trace-output* (setq *data-trace-output* *trace-output*))
1324
 (setq *bgp-trace-output* *trace-output*)
1325
 
1326
 (run-test-query "
1327
 PREFIX ex: <http://www.w3.org/2009/sparql/docs/tests/data-sparql11/negation#>
1328
 PREFIX dc: <http://purl.org/dc/elements/1.1/>
1329
 
1330
 # The closest pre-operative physical examination
1331
 SELECT ?exam ?date { 
1332
   ?exam a ex:PhysicalExamination; 
1333
         dc:date ?date;
1334
         ex:precedes ex:operation1 .
1335
   ?op   a ex:SurgicalProcedure; dc:date ?opDT .
1336
   FILTER NOT EXISTS {
1337
     ?otherExam a ex:PhysicalExamination; 
1338
                ex:follows ?exam;
1339
                ex:precedes ex:operation1
1340
   } 
1341
 }
1342
 "
1343
                 :repository-id (lookup-repository-id :repository-name "negation-temporal-proximity-by-exclusion-nex-1" :account-name "jhacker"))
1344
 
1345
 |#