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

Kind	Covered	All	%
expression	1112	2691	41.3
branch	129	378	34.1

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 the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(long-description

11

"The file defines the operators for SAE from the 'SPARQL Query Language for RDF'[1] specification.

12

  Most operators are defined in two aspects. A macro in the specification package (spocq.a or xsd) implements

13

  any control and evaluation order transformations, records variable information, and rewrites the expression

14

in terms of the evaluation library. A second function in the evaluation package (spocq.e)

15

implements the operation. The logical combinations are exceptions, which expanid into the respective

16

evaluation and testing logic.

17

18

The specification describes[2] a protocol whereby each function accepts typed literals, transforms them

19

to their respective typed value, performs the operation, and transforms them back to typed literals

20

upon return. The referenced XPath specification sets no such requirement. It permits the application

21

the represent the data either way as long as the external form is as specified. SAE interns all

22

values with native representations, operates on the native value and serializes with datatypes only

23

if the value had a data type originally.

24

25

A survey of the implemenation practice as of 2011 was presented at that year's ISWC[4].

26

Operators for temporal datatypes are implemented separately.

27

28

---

29

[1]: http://www.w3.org/TR/rdf-sparql-query/#OperatorMapping.

30

[2]: http://www.w3.org/TR/rdf-sparql-query/#operandDataTypes

31

[3]: http://www.w3.org/TR/xpath20/#dt-typed-value

32

[4]: http://iswc2011.semanticweb.org/fileadmin/iswc/Papers/Workshops/SSWS/Emmons-et-all-SSWS2011.pdf

33

34

"))

35

36

37

;;; clear the wilbur definition

38

;;; otherwise the generated parser state machine will fail to compile

39

40

;; #.(set-macro-character #\! nil)

41

#.(set-syntax-from-char #\! #\a)

42

43

(macrolet ((def-op ((interface-name implementation-name) parameters &rest body)

44

`(progn (defmacro ,interface-name ,parameters

45

,@(when (stringp (first body)) (list (first body)))

46

,@(mapcar #'(lambda (parameter)

47

                                      `(setf (variable-opacity (expression-variables ,parameter)) :transparent))

48

parameters)

49

(list ',implementation-name ,@parameters))

50

(defgeneric ,implementation-name ,parameters

51

                        (:method ,(mapcar #'(lambda (parameter) `(,parameter number)) parameters)

52

,@body)))))

53

(def-op (spocq.a:|abs| spocq.e:abs) (term)

54

"( ( numeric ) numeric )

55

 The function ABS returns the absolute value of arg. An error is raised if arg is not a numeric value.

56

57

This function is the same as fn:numeric-abs for terms with a datatype from XDM."

58

(if (or (eql term de.setf.utility.codecs:double-float-nan)

59

(eql term de.setf.utility.codecs:double-float-positive-infinity)

60

(eql term de.setf.utility.codecs:double-float-negative-infinity)

61

(eql term nan) (eql term +inf) (eql term -inf))

62

term

63

(abs term)))

64

65

(def-op (spocq.a:|ceil| spocq.e:ceil) (term)

66

"( ( numeric ) numeric )

67

The function CEIL returns the smallest (closest to negative infinity) number

68

with no fractional part that is not less than the value of arg. An error is

69

raised if arg is not a numeric value.

70

71

This function is the same as fn:numeric-ceil for terms with a datatype from XDM."

72

(cond ((or (eql term de.setf.utility.codecs:double-float-nan)

73

(eql term de.setf.utility.codecs:double-float-positive-infinity)

74

(eql term de.setf.utility.codecs:double-float-negative-infinity)

75

(eql term nan) (eql term +inf) (eql term -inf))

76

term)

77

(t

78

(ceiling term))))

79

80

(def-op (spocq.a:|floor| spocq.e:floor) (term)

81

"( ( numeric ) numeric )

82

The function FLOOR returns the largest (closest to positive infinity) number

83

with no fractional part that is not greater than the value of arg. An error

84

is raised if arg is not a numeric value.

85

86

This function is the same as fn:numeric-floor for terms with a datatype from XDM."

87

(cond ((or (eql term de.setf.utility.codecs:double-float-nan)

88

(eql term de.setf.utility.codecs:double-float-positive-infinity)

89

(eql term de.setf.utility.codecs:double-float-negative-infinity)

90

(eql term nan) (eql term +inf) (eql term -inf))

91

term)

92

(t

93

(floor term))))

94

95

(def-op (spocq.a:|round| spocq.e:round) (term)

96

"( ( numeric ) numeric )

97

The function ROUND returns the number with no fractional part that is closest to the argument.

98

If there are two such numbers, then the one that is closest to positive infinity

99

is returned. An error is raised if arg is not a numeric value.

100

101

This function is the same as fn:numeric-round for terms with a datatype from XDM."

102

(if (or (eql term de.setf.utility.codecs:double-float-nan)

103

(eql term de.setf.utility.codecs:double-float-positive-infinity)

104

(eql term de.setf.utility.codecs:double-float-negative-infinity)

105

(eql term nan) (eql term +inf) (eql term -inf))

106

term

107

;; cl rounds to even, rdf to +infinity

108

(multiple-value-bind (rounded rem) (round term)

109

(declare (type integer rounded))

110

(if (and (>= rounded 0) (evenp rounded) (= rem 0.5))

111

(+ rounded 1)

112

rounded))))

113

114

(def-op (spocq.a:|rand| spocq.e:rand) ()

115

"( () xsd:double )

116

The function RAND returns a pseudo-random number between 0 (inclusive) and 1.0e0 (exclusive).

117

Different numbers can be produced every time this function is invoked.

118

Numbers should be produced with approximately equal probability."

119

(random 1.0d0)))

120

121

122

(macrolet ((def-op ((interface-name implementation-name) (parameter) &rest body)

123

`(progn (defmacro ,interface-name (,parameter)

124

                        (setf (variable-opacity (expression-variables ,parameter)) :transparent)

125

(list ',implementation-name ,parameter))

126

(defgeneric ,implementation-name (,parameter)

127

(:method ((,parameter string))

128

,@body)

129

(:method ((term spocq:plain-literal))

130

                          (intern-term-aspects :literal (,implementation-name (spocq:literal-lexical-form term))

131

                                             nil (spocq:plain-literal-language-tag term)))

132

(:method ((term spocq:string))

133

(,implementation-name (spocq:literal-lexical-form term)))))))

134

(def-op (spocq.a:|ucase| spocq.e:ucase) (str)

135

"( ( stringLiteral ) stringLiteral )

136

The UCASE function corresponds to the XPath fn:upper-case function.

137

It returns a string literal whose lexical form is the upper case of the lexical

138

form of the argument."

139

(string-upcase str))

140

(def-op (spocq.a:|lcase| spocq.e:lcase) (str)

141

"( ( stringLiteral ) stringLiteral )

142

The LCASE function corresponds to the XPath fn:lower-case function.

143

It returns a string literal whose lexical form is the lower case of the lexical

144

form of the argument."

145

(string-downcase str)))

146

147

(macrolet ((def-op ((interface-name implementation-name) (parameter) &rest body)

148

`(progn (defmacro ,interface-name (,parameter)

149

                        (setf (variable-opacity (expression-variables ,parameter)) :transparent)

150

(list ',implementation-name ,parameter))

151

(defgeneric ,implementation-name (,parameter)

152

(:method ((,parameter string))

153

,@body)

154

(:method ((term spocq:plain-literal))

155

(,implementation-name (spocq:literal-lexical-form term)))

156

(:method ((term spocq:string))

157

(,implementation-name (spocq:literal-lexical-form term)))))))

158

(def-op (spocq.a:|strlen| spocq.e:string-length) (term)

159

"( ( stringLiteral ) xsd:integer )

160

The strlen function corresponds to the XPath fn:string-length function and

161

returns an xsd:integer equal to the length in characters of the lexical form of

162

the literal."

163

(length term)))

164

165

(macrolet ((def-op ((interface-name implementation-name) (parameter) &rest body)

166

`(progn (defmacro ,interface-name (,parameter)

167

                        (setf (variable-opacity (expression-variables ,parameter)) :transparent)

168

(list ',implementation-name ,parameter))

169

(defgeneric ,implementation-name (,parameter)

170

(:method ((,parameter string))

171

,@body)

172

(:method ((,parameter spocq:plain-literal))

173

(,implementation-name (spocq:literal-lexical-form ,parameter)))

174

(:method ((term spocq:string))

175

(,implementation-name (spocq:literal-lexical-form term)))))))

176

177

;; operators defined on simple, plain, and string-typed literals only

178

(def-op (spocq.a:|encode_for_uri| spocq.e:encode-for-uri) (literal)

179

"( ( stringLiteral ) simpleLiteral )

180

The ENCODE_FOR_URI function corresponds to the XPath fn:encode-for-uri function.

181

It returns a simple literal with the lexical form obtained from the lexical form

182

of its input after translating reserved characters according to the

183

fn:encode-for-uri function."

184

(encode-for-uri literal))

185

186

(def-op (spocq.a:|md5| spocq.e:md5) (arg)

187

"( (or xsd:String simpleLiteral ) simpleLiteral )

188

The function MD5 returns the MD5 checksum, as a hex digit string,

189

calculated on the UTF-8 representation of the simple literal or lexical form of

190

the xsd:string. Hex digits should be in lower case."

191

(make-md5-digest arg))

192

(def-op (spocq.a:|sha1| spocq.e:sha1) (arg)

193

"( (or xsd:String simpleLiteral ) simpleLiteral )

194

The function SHA1 returns the SHA1 checksum, as a hex digit string,

195

calculated on the UTF-8 representation of the simple literal or lexical form of

196

the xsd:string. Hex digits should be in lower case."

197

(make-sha1-digest arg))

198

(def-op (spocq.a:|sha224| spocq.e:sha224) (arg)

199

"( (or xsd:String simpleLiteral ) simpleLiteral )

200

The function SHA224 returns the SHA224 checksum, as a hex digit string,

201

calculated on the UTF-8 representation of the simple literal or lexical form of

202

the xsd:string. Hex digits should be in lower case."

203

(make-sha224-digest arg))

204

(def-op (spocq.a:|sha256| spocq.e:sha256) (arg)

205

"( (or xsd:String simpleLiteral ) simpleLiteral )

206

The function SHA256 returns the SHA256 checksum, as a hex digit string,

207

calculated on the UTF-8 representation of the simple literal or lexical form of

208

the xsd:string. Hex digits should be in lower case."

209

(make-sha256-digest arg))

210

(def-op (spocq.a:|sha384| spocq.e:sha384) (arg)

211

"( (or xsd:String simpleLiteral ) simpleLiteral )

212

The function SHA384 returns the SHA364 checksum, as a hex digit string,

213

calculated on the UTF-8 representation of the simple literal or lexical form of

214

the xsd:string. Hex digits should be in lower case."

215

(make-sha384-digest arg))

216

(def-op (spocq.a:|sha512| spocq.e:sha512) (arg)

217

"( (or xsd:String simpleLiteral ) simpleLiteral )

218

The function SHA512 returns the SHA512 checksum, as a hex digit string,

219

calculated on the UTF-8 representation of the simple literal or lexical form of

220

the xsd:string. Hex digits should be in lower case."

221

(make-sha512-digest arg)))

222

223

224

(defmacro spocq.a:|iri| (expression)

225

"( ( RDFTerm ) iri)

226

 The IRI function constructs an IRI by resolving the string argument (see RFC 3986 and RFC 3987 or any later RFC that superceeds RFC 3986 or RFC 3987).

227

The IRI is resolved against the base IRI of the query and must result in an absolute IRI.

228

The URI function is a synonym for IRI.

229

If the function is passed an IRI, it returns the IRI unchanged.

230

Passing any RDF term other than a simple literal, xsd:string or an IRI is an error.

231

An implementation may normalize the IRI."

232

233

(setf (variable-opacity (expression-variables expression)) :transparent)

234

`(spocq.e:iri ,expression))

235

236

(defgeneric spocq.e:iri (term)

237

238

(:method ((object spocq:unbound-variable))

239

object)

240

241

(:method ((term string))

242

(merge-and-intern-iri term))

243

(:method ((term spocq:iri))

244

;; an iri argument is returned unchanged

245

term)

246

(:method ((term symbol))

247

term)

248

(:method ((term spocq:string))

249

(spocq.e:iri (spocq:literal-lexical-form term))))

250

251

(defmacro spocq.a:|uri| (expression)

252

"( ( RDFTerm ) iri)

253

The URI function is a synonym for IRI."

254

255

`(spocq.a:|iri| ,expression))

256

257

258

(macrolet ((def-op ((interface-name implementation-name) (parameter1 parameter2) &rest body)

259

`(progn (defmacro ,interface-name (,parameter1 ,parameter2)

260

                        (setf (variable-opacity (expression-variables ,parameter1)) :transparent)

261

                        (setf (variable-opacity (expression-variables ,parameter2)) :transparent)

262

(list ',implementation-name ,parameter1 ,parameter2))

263

(defgeneric ,implementation-name (,parameter1 ,parameter2)

264

(:method ((,parameter1 string) (,parameter2 string))

265

,@body)

266

(:method ((term1 spocq:string) (term2 t))

267

(,implementation-name (spocq:literal-lexical-form term1) term2))

268

(:method ((term1 t) (term2 spocq:string))

269

(,implementation-name term1 (spocq:literal-lexical-form term2)))

270

(:method ((term1 spocq:plain-literal) (term2 t))

271

(,implementation-name (spocq:literal-lexical-form term1) term2))

272

;; perform implicit iri conversion

273

(:method ((term1 spocq:iri) (term2 t))

274

(,implementation-name (spocq:iri-lexical-form term1) term2))

275

(:method ((term1 t) (term2 spocq:iri))

276

(,implementation-name term1 (spocq:iri-lexical-form term2)))

277

#+(or) ;; as of WD-sparql11-query-20120105 these are incompatible

278

(:method ((term1 t) (term2 spocq:plain-literal))

279

(,implementation-name term1 (spocq:literal-lexical-form term2)))

280

(:method ((term1 t) (term2 spocq:plain-literal))

281

(spocq.e:argument-type-error :datum (list term1 term2)

282

                                                       :operator ',interface-name

283

                                                       :expected-type 'spocq:plain-literal))

284

(:method ((term1 spocq:plain-literal) (term2 spocq:plain-literal))

285

(if (equal (spocq:plain-literal-language-tag term1)

286

(spocq:plain-literal-language-tag term2))

287

(,implementation-name (spocq:literal-lexical-form term1)

288

                                                  (spocq:literal-lexical-form term2))

289

(spocq.e:argument-type-error :datum (list term1 term2)

290

                                                         :operator ',interface-name

291

                                                         :expected-type 'spocq:plain-literal)))))))

292

293

(def-op (spocq.a:|strstarts| spocq.e:string-starts) (arg1 arg2)

294

"( ( stringLiteral stringLiteral ) xsd:boolean )

295

The STRSTARTS function corresponds to the XPath fn:starts-with function.

296

The arguments must be argument compatible otherwise an error is raised.

297

298

For such input pairs, the function returns true if the lexical form of arg1

299

starts with the lexical form of arg2, otherwise it returns false."

300

(and (>= (length arg1) (length arg2))

301

(string= arg1 arg2 :end1 (length arg2))))

302

303

(def-op (spocq.a:|strends| spocq.e:string-ends) (arg1 arg2)

304

"( ( stringLiteral stringLiteral ) xsd:boolean )

305

The STRENDS function corresponds to the XPath fn:ends-with function.

306

The arguments must be argument compatible otherwise an error is raised.

307

308

For such input pairs, the function returns true if the lexical form of arg1

309

ends with the lexical form of arg2, otherwise it returns false."

310

(and (>= (length arg1) (length arg2))

311

(string= arg1 arg2 :start1 (- (length arg1) (length arg2)))))

312

313

(def-op (spocq.a:|contains| spocq.e:contains) (arg1 arg2)

314

"( ( stringLiteral stringLiteral ) xsd:boolean )

315

The CONTAINS function corresponds to the XPath fn:contains.

316

The arguments must be argument compatible otherwise an error is raised."

317

(when (search arg2 arg1) t)))

318

319

320

321

(defmacro spocq.a:|bnode| (&optional literal)

322

"( ( literal? ) blankNode )

323

The recommendation requires the operator to contribute to per-solution state:

324

325

The BNODE function constructs a blank node that is distinct from all blank nodes

326

in the dataset being queried and distinct from all blank nodes created by calls

327

to this constructor for other query solutions.

328

If the no argument form is used, every call results in a distinct blank node.

329

If the form with a simple literal is used, every call results in distinct blank

330

nodes for different simple literals, and the same blank node for calls with the

331

same simple literal within expressions for one solution mapping.

332

333

As this is not obviously feasible, the solutions treats the label as global."

334

335

(let ((variables (expression-variables literal)))

336

(when variables (setf (variable-opacity variables) :transparent)))

337

`(spocq.e:bnode ,@(when literal (list literal))))

338

339

(defun spocq.e:bnode (&optional literal)

340

(typecase literal

341

(null (cons-global-blank-node :prefix "b"))

342

(string (intern-blank-node literal))

343

(t

344

(invalid-argument-type spocq.a:|bnode| literal |xsd|:|string|))))

345

346

347

(deftype |xsd|:|boolean| ()

348

"The XSD boolean type strictly comprises 'true' and 'false' literals, but is extended in the

349

evaluation environment to include t and nil."

350

'(member t nil spocq.a:|true| spocq.a:|false|))

351

352

(defun spocq.e:boolean-p (object)

353

(when (member object '(t nil spocq.a:|true| spocq.a:|false|))

354

t))

355

356

357

(defmacro spocq.a:|bound| (var &environment env)

358

"( ( RDFTerm ) xsd:boolean )

359

The function BOUND returns true if var is bound to a value. Returns false otherwise.

360

Variables with the value NaN or INF are considered bound.

361

If there is no lexical definition, the result is constantly false."

362

363

(let ((expression-expansion (macroexpand-1 var env)))

364

(cond ((field-object-aref-p expression-expansion)

365

`(/= (aref ,@(field-object-aref-aref expression-expansion)) +null-term-id+))

366

((and (consp expression-expansion)

367

(eq (first expression-expansion) 'spocq:make-unbound-variable))

368

;; statically unbound

369

nil)

370

((symbolp var)

371

`(spocq.e:bound ,var))

372

(t

373

(spocq.e:argument-type-error :datum var :operator 'spocq.a:|bound|

374

:expected-type 'variable)))))

375

376

377

(defun query-binding-value (variable-name)

378

   "if the variable has been bound by the query, return that value. Otherwise return an unbound marker."

379

(or (and (variable-p variable-name) ;; exclude iri constants

380

(boundp variable-name)

381

(term-number-object (symbol-value variable-name)))

382

(spocq:make-unbound-variable variable-name)))

383

384

(defun query-binding-term-number (variable-name)

385

   "if the variable has been bound by the query, return that value. Otherwise return an unbound marker."

386

(if (boundp variable-name)

387

(symbol-value variable-name)

388

+null-term-id+))

389

390

(defun spocq.e:bound (value)

391

(typecase value

392

(spocq:unbound-variable nil)

393

(t t)))

394

395

(defmacro spocq.a::|call| (op &rest args)

396

`(spocq.e::call ',op ,@args))

397

398

(defgeneric iri-function-value (iri)

399

(:method ((iri symbol))

400

(if (fboundp iri)

401

(fdefinition iri)

402

(call-next-method)))

403

(:method ((iri t))

404

nil))

405

406

(defgeneric spocq.e::call (op &rest args)

407

(:method ((op function) &rest args)

408

(declare (dynamic-extent args))

409

(apply op args))

410

(:method ((designator t) &rest args)

411

(declare (dynamic-extent args))

412

(let ((function (iri-function-value designator)))

413

(typecase function

414

(function (apply #'spocq.e::call function args))

415

(t (error 'undefined-function :name designator))))))

416

417

418

(defmacro spocq.a::|coalesce| (&rest expressions)

419

"( rdfTerm )

420

The COALESCE function returns the value of the first expression which evaluates without an error.

421

In SPARQL, evaluating an unbound variable raises an error.

422

If none of the arguments evaluates to an RDF term, an error is raised.

423

If no expressions are evaluated without error, an error is raised.

424

425

Check at compile time, if an expression is a variable and, if so preface the evaluation with

426

a test for unbound to skip the error handling."

427

428

;; although the immediate result depends only on whether the expression completes

429

;; the result (eg grouping/group04) may be bound, selected or otherwise

430

;; used as an argument to an operator.

431

(setf (variable-opacity (expression-variables expressions)) :transparent)

432

(let ((block (gensym "COALESCE")))

433

`(block ,block

434

,@(mapcar #'(lambda (expression)

435

(if (symbolp expression)

436

`(unless (spocq:unbound-variable-p ,expression)

437

                         (ignore-errors (return-from ,block (spocq.e:identity ,expression))))

438

`(ignore-errors (return-from ,block (spocq.e:identity ,expression)))))

439

expressions)

440

(error "no coalesce expression completed: ~a." 'expressions))))

441

442

443

(defgeneric spocq.e:identity (term)

444

(:documentation "return the term as long as it is not unbound.")

445

(:method ((term spocq:unbound-variable))

446

(spocq.e:undefined-variable-error :name (spocq:unbound-variable-name term)))

447

(:method ((term (eql etf:nil)))

448

(spocq.e:undefined-variable-error :name nil))

449

(:method ((term t))

450

term))

451

452

453

(defmacro spocq.a:|concat| (&rest literals)

454

"( ( stringLiteral* ) stringLiteral )

455

The CONCAT function corresponds to the XPath fn:concat function.

456

The function accepts string literals as arguments.

457

458

The lexical form of the returned literal is obtained by concatenating the

459

lexical forms of its inputs. If all input literals are typed literals of type

460

xsd:string, then the returned literal is also of type xsd:string, if all input

461

literals are plain literals with identical language tag, then the returned

462

literal is a plain literal with the same language tag, in all other cases, the

463

returned literal is a simple literal."

464

(dolist (expression literals)

465

(setf (variable-opacity (expression-variables expression)) :transparent))

466

`(spocq.e:string-concatenate ,@literals))

467

468

469

470

(defun spocq.e:string-concatenate (&rest terms)

471

   "Iff the arguments are all strings, concatenate them. Iff they all are plain w/ the same tag, annotate them

472

accordingly. If the tags/types are null or do not match, return a simple string literal.

473

For a non-string datatype signal an error.

474

   The logic wrt plain/string follows the tag proposal [http://www.w3.org/2011/rdf-wg/wiki/StringLiterals/AbolishUntaggedPlain]

475

in that the two are equivalent."

476

(declare (dynamic-extent terms))

477

(let* ((datatypes)

478

(language-tags)

479

(invalid-datatypes ())

480

(strings ()))

481

(loop for term in terms

482

do (typecase term

483

(string

484

(unless (rest datatypes) (pushnew :string datatypes))

485

(push term strings))

486

(spocq:string

487

(unless (rest datatypes) (pushnew :string datatypes))

488

(push (spocq:literal-lexical-form term) strings))

489

(spocq:plain-literal

490

(unless (rest datatypes) (pushnew :plain datatypes))

491

(unless (rest language-tags)

492

                   (pushnew (spocq:plain-literal-language-tag term) language-tags :test #'string-equal))

493

(push (spocq:literal-lexical-form term) strings))

494

(t (push (spocq.e:data-type term) invalid-datatypes))))

495

(when invalid-datatypes

496

(invalid-argument-type spocq.a::|concat| terms (list |xsd|:|string|)))

497

(if (and (eq (first datatypes) :plain) (null (rest datatypes))

498

(null (rest language-tags)))

499

(let ((result (apply #'concatenate 'string (nreverse strings))))

500

(intern-term-aspects :literal result nil (first language-tags)))

501

         ;; do not intern the result and construct it rather than using concatenate takes about half the time

502

(let* ((length (reduce #'+ strings :initial-value 0 :key #'length))

503

(result (make-string length)))

504

;; do not (constrain-string-length result)

505

;; leave that to when interning in the store

506

(loop for string in strings

507

for offset = (- length (length string)) then (- offset (length string))

508

do (replace result string :start1 offset))

509

result)

510

#+(or)

511

(apply #'concatenate 'string (nreverse strings))

512

#+(or)

513

(intern-term-aspects :literal (apply #'concatenate 'string (nreverse strings))

514

|xsd|:|string| nil))))

515

516

517

(defmacro spocq.a:|count| (subject predicate object &optional graph)

518

`(spocq.e:count ',subject ',predicate ',object ,@(when graph (list (list 'quote graph)))))

519

520

(defun spocq.e:count (subject predicate object &optional (graph '|urn:dydra|:|default|))

521

;; always reread it

522

(read-repository-pattern-count *repository* subject predicate object graph))

523

524

525

(eval-when (:compile-toplevel :load-toplevel :execute)

526

(defun macroexpand-datatype (literal)

527

(setf (variable-opacity (expression-variables literal)) :transparent)

528

`(spocq.e:data-type ,literal)))

529

530

(defmacro spocq.a:|datatype| (literal)

531

"( ( literal ) iri )

532

Returns the datatype IRI of a literal.

533

- If the literal is a typed literal, return the datatype IRI.

534

- If the literal is a simple literal, return xsd:string

535

- If the literal is literal with a language tag, return rdf:langString"

536

537

(macroexpand-datatype literal))

538

539

(defgeneric spocq.e:data-type (term)

540

541

(:method ((object spocq:unbound-variable))

542

object)

543

544

(:method ((object symbol))

545

(if (spocq.e:iri-p object)

546

'|xsd|:|anyURI|

547

(spocq.e:argument-type-error :operator 'spocq.a:|datatype|

548

:expected-type '|xsd|:|anyURI|

549

:datum object)))

550

(:method ((object spocq:iri))

551

'|xsd|:|anyURI|)

552

(:method ((object spocq:literal))

553

(spocq:literal-datatype-uri object))

554

(:method ((object string)) '|xsd|:|string|)

555

(:method ((object integer)) '|xsd|:|integer|)

556

(:method ((object double-float)) '|xsd|:|double|)

557

(:method ((object float)) '|xsd|:|float|)

558

(:method ((object ratio)) '|xsd|:|decimal|)

559

(:method ((object (eql t))) '|xsd|:|boolean|)

560

(:method ((object spocq:blank-node)) '|rdf|:|blankNode|)

561

(:method ((term null)) '|xsd|:|boolean|))

562

563

564

(:documentation "running `exists` subqueries"

565

"The `exists` operation entails running a subquery and handling the results as for an `ask`.

566

That is, if any solution appears, the filter argument result is `true` and otherwise it is `false`.

567

568

If the filter form is just a bgp, then that can be executed with sip in the context of the

569

filter as it will have access to the solution to which the filter is to be applied, can extract

570

pertinent bindings and pass them into the bgp as initial bindings.

571

In the other cases, the filter expression is compound and its execution can involve references

572

to both the initial field and to bindings in the bgp.

573

For these cases, the entire exists form must be evaluated with the current solution transformed into

574

dynamic bindings. Instead of evaluating the sub-expression over the field, the field dimension is

575

reduced to zero and the operation is performed in the context of a surrogate query, which serves

576

as the context to initiate generation and carries the extended bindings.

577

578

  In the simple bgp case, this was restructured to behave the same as if it were the solution field result of

579

a bgp match, with a test for just a single solution set.

580

  That fails to accommodate all necessary expressions, as the outer form may be something other than an

581

  actual bgp, which means it does not in generall allow for sip.In the general case, the control flows from the evaluation of an expression as part of a computed projection -

582

  a select assignment or a bind form, or contributing to a filter constraint, there is no dataflow in the

583

form of an argument solution field for an algebraic reduction. Instead, there is only the current

584

page and index for the solution against which the expression is being interpreted.

585

The evaluation definition, as per recommendation, is:

586

587

     The value exists(P), given D(G) is true if and only if eval(D(G), substitute(P, μ)) is a non-empty sequence.

588

589

and the forms may be complex, as in,

590

prefix : <http;//example.org#>

591

select * {

592

filter ( not exists { ?s :p1 ?o } || exists { ?s :p2 ?o } )

593

}

594

which requires a logical combination rather than a simple join. In order to permit the arbitrary

595

sub-expression, it is wrapped in task clone, which accepts bindings, extends the dynamic environment

596

with them and then executes the form.")

597

598

(defmacro spocq.a:|exists| (pattern &environment env)

599

"( xsd:boolean )

600

The filter operator EXISTS that takes a graph pattern and returns true/false

601

depending on whether the pattern matches the dataset given the bindings in the

602

current group graph pattern, the dataset and the active graph at this point

603

in the query evaluation. No additional binding of variables occurs.

604

605

The NOT EXISTS form translates into fn:not(EXISTS{...})."

606

607

(macroexpand-exists pattern env))

608

609

610

(defun macroexpand-exists (expression env)

611

"Expand an exists filter phrase to apply over either a binary field, a unary field, or

612

without reference to initial query results. The context is apparent from the respective

613

declarations present in the compilation context.

614

Where the expression is just a bgp, the implementation can proceed as sip into the bgp

615

matching function with no result yielding true and any result yielding false.

616

For any other constituent form, it must be executed as if it were an ask its own sub-query.

617

The sub-query is required as the substitution rules (see above) are effected by extending

618

the principle query's dynamic bindings to carry over the bindings from the filter's

619

current solution."

620

621

(let* ((dimensions (first (declaration-information 'spocq.e:dimensions env)))

622

(join-dimensions (declaration-information 'spocq.e:join-dimensions env))

623

(bgp-p (bgp-form-p expression))

624

(free-dimensions (expression-free-dimensions expression))

625

(referenced-dimensions (intersect-dimensions free-dimensions dimensions))

626

;;(remaining-base-dimensions (difference-dimensions dimensions referenced-dimensions))

627

)

628

(setf expression `(spocq.e::with-join-scope ,(gensym "exists-")

629

(spocq.e::with-processing-mode :synchronous ,expression)))

630

(cond (join-dimensions

631

;; within a filter in a join operation

632

(destructuring-bind (join left right) join-dimensions

633

(declare (ignore left right))

634

(if bgp-p

635

`(locally (declare (spocq.e:base-dimensions ,@join))

636

                     (spocq.e:binary-exists ,expression left-page left-index right-page right-index

637

                                            ,(apply #'compute-binary-collector-lambda join-dimensions)

638

                                            ,(length (first join-dimensions))))

639

`(let* ((surrogate-task

640

                           ;; cannot cache a constant, as the expansion itself is cached across queries

641

                         ;; and the surrogate task's transaction will be cleared or otherwise wrong

642

(compute-extended-task *task*

643

                                                :dynamic-bindings-dimensions ',referenced-dimensions

644

                                                :operation 'spocq.a:|exists|

645

                                                :sse-expression ',expression))

646

(dynamic-bindings (query-dynamic-bindings surrogate-task))

647

(dynamic-values (rest dynamic-bindings)))

648

;;; leave it, but avoid the compilation error

649

,@(unless referenced-dimensions '((declare (ignore dynamic-values))))

650

;; none remain as all should be dynamic

651

;;(declare (spocq.e:base-dimensions ,@remaining-base-dimensions))

652

;; record the intended dynamic bindings by modifying them in-place

653

,@(loop for variable in referenced-dimensions

654

collect `(progn (setf (first dynamic-values) ,variable)

655

(pop dynamic-values)))

656

;; (print (list :bindings *task* surrogate-task dynamic-bindings))

657

                     ;; pass the clone which was captured by the compile step, with extended bindings

658

(spocq.e::dynamic-exists ,(if (slice-form-p expression)

659

expression

660

                                                   `(spocq.a:|slice| ,expression :count 1))

661

surrogate-task)))))

662

(dimensions

663

(if bgp-p

664

;; a simple bgp within a filter in a single field

665

`(locally (declare (spocq.e:base-dimensions ,@dimensions))

666

(spocq.e:unary-exists ,expression base-page base-index))

667

`(let* ((surrogate-task

668

                         ;; cannot cache a constant, as the expansion itself is cached across queries

669

                         ;; and the surrogate task's transaction will be cleared or otherwise wrong

670

(compute-extended-task *task*

671

                                                :dynamic-bindings-dimensions ',referenced-dimensions

672

                                                :operation 'spocq.a:|exists|

673

                                                :sse-expression ',expression))

674

(dynamic-bindings (query-dynamic-bindings surrogate-task))

675

(dynamic-values (rest dynamic-bindings)))

676

;;; leave it, but avoid the compilation error

677

,@(unless referenced-dimensions '((declare (ignore dynamic-values))))

678

;;(declare (spocq.e:base-dimensions ,@remaining-base-dimensions))

679

;; record the intended dynamic bindings by modifying them in-place

680

,@(loop for variable in referenced-dimensions

681

collect `(progn (setf (first dynamic-values) ,variable)

682

(pop dynamic-values)))

683

;; (print (list :bindings *task* surrogate-task dynamic-bindings))

684

                   ;; pass the clone which was captured by the compile step, with extended bindings

685

(spocq.e::dynamic-exists ,(if (slice-form-p expression)

686

expression

687

                                                   `(spocq.a:|slice| ,expression :count 1))

688

surrogate-task))))

689

(t

690

;; autonomous

691

`(spocq.e:null-exists ,expression)))))

692

693

(defgeneric compute-extended-task (task &key dynamic-bindings-dimensions operation sse-expression)

694

(:method ((task query) &key (dynamic-bindings-dimensions ()) (operation 'spocq.a:|null|)

695

(sse-expression ()))

696

     (let ((cloned-task (clone-instance task :id (concatenate 'string (task-id task) "." (string operation))

697

:operation operation

698

:sse-expression sse-expression))

699

(bindings (query-dynamic-bindings task)))

700

(setf (query-dynamic-bindings cloned-task)

701

(cons (append dynamic-bindings-dimensions (first bindings))

702

(append (make-list (length dynamic-bindings-dimensions)) (rest bindings))))

703

(setf-task-transaction (get-task-transaction task) cloned-task)

704

cloned-task)))

705

706

707

708

(defgeneric spocq.e:null-exists (solution-field)

709

(:documentation "Yield true iff the solution field is not empty. 'null' indicates no base page.")

710

711

#+agp-algebra-specialization

712

(:method ((field agp))

713

(process-null-exists (agp-generator field)))

714

715

(:method ((field solution-generator))

716

(process-null-exists field))

717

718

(:method ((field null-generator))

719

nil))

720

721

(defun process-null-exists (bgp-generator)

722

(flet ((exists-continuation (page)

723

(trace-data exists-continuation (term-value-field page))

724

(return-from process-null-exists (not (null page)))))

725

(funcall (bgp-generator-pattern-function bgp-generator)

726

#'exists-continuation)

727

(log-warn "exists match function returned.")

728

nil))

729

730

731

(defgeneric spocq.e:unary-exists (solution-field base-page base-index)

732

(:documentation "Yield true iff the solution field is not empty.

733

The base page is the source of bindings.")

734

735

#+agp-algebra-specialization

736

(:method ((field agp) base-page base-index)

737

(process-unary-exists (agp-generator field) base-page base-index))

738

739

(:method ((field solution-generator) base-page base-index)

740

(process-unary-exists field base-page base-index))

741

742

(:method ((field null-generator) base-page base-index)

743

nil)

744

745

(:method ((f t) (bp t) (bi t))

746

(log-warn "unary-exists: ~a ~a ~a" f bp bi)

747

nil))

748

749

#+(or)

750

(defun process-unary-exists (bgp-generator base-page base-index)

751

(let* ((agp (first (solution-generator-patterns bgp-generator)))

752

(base-channel (agp-base-channel agp))

753

(result-channel (solution-generator-channel bgp-generator))

754

(base-page-width (array-dimension base-page 1))

755

(bgp-base-page (make-page 1 base-page-width)))

756

(loop for i-from from (array-row-major-index base-page base-index 0)

757

for i-to from 0 below base-page-width

758

do (setf (row-major-aref bgp-base-page i-to) (row-major-aref base-page i-from)))

759

(trace-data process-unary-exists (term-value-field bgp-base-page))

760

(trace-data exists-dequeue bgp-base-page (term-value-field bgp-base-page))

761

(channel-put base-channel bgp-base-page)

762

(trace-data exists-dequeue nil nil)

763

(complete-field base-channel)

764

(let ((expression (solution-generator-expression bgp-generator)))

765

(apply (first expression) (rest expression)))

766

(let ((page (channel-get result-channel)))

767

(trace-data exists-continuation (term-value-field page))

768

(not (null page)))))

769

770

771

(defgeneric process-unary-exists (generator base-page base-index)

772

(:documentation "given a generator - either an immediate bgp or some other source,

773

attempt to accept its solutions. if there are any, then return true.

774

otherwise, return false.")

775

776

(:method ((generator bgp-generator) base-page base-index)

777

(trace-algebra process-unary-exists generator base-page base-index)

778

(let* ((pattern-function (bgp-generator-pattern-function generator))

779

(base-page-width (array-dimension base-page 1))

780

(bgp-base-page (make-page 1 base-page-width)))

781

(flet ((exists-dequeue ()

782

(trace-data exists-dequeue (term-value-field bgp-base-page))

783

(shiftf bgp-base-page nil))

784

(exists-continuation (page)

785

(trace-data exists-continuation (term-value-field page))

786

(return-from process-unary-exists (not (null page)))))

787

(loop for i-from from (array-row-major-index base-page base-index 0)

788

for i-to from 0 below base-page-width

789

do (setf (row-major-aref bgp-base-page i-to) (row-major-aref base-page i-from)))

790

;; pass control to the bgp function. it will continue with either a page or nil

791

(funcall pattern-function #'exists-continuation #'exists-dequeue)

792

(log-warn "exists match function returned.")

793

nil))))

794

795

796

 (defgeneric spocq.e:binary-exists (solution-field left-page left-index right-page right-index collector page-width)

797

(:documentation "Yield true iff the solution field is not empty.

798

The base bage is the source of bindings.")

799

800

#+agp-algebra-specialization

801

(:method ((field agp) left-page left-index right-page right-index collector page-width)

802

(process-binary-exists (agp-pattern-function field)

803

left-page left-index right-page right-index

804

collector page-width))

805

806

(:method ((field solution-generator) left-page left-index right-page right-index collector page-width)

807

(process-binary-exists field left-page left-index right-page right-index

808

collector page-width))

809

810

(:method ((field null-generator) left-page left-index right-page right-index collector page-width)

811

(declare (ignore left-page left-index right-page right-index collector page-width))

812

nil))

813

814

#+(or)

815

(defun process-binary-exists (bgp-generator left-page left-index right-page right-index

816

                                                      collector base-page-width)

817

(let* ((agp (first (solution-generator-patterns bgp-generator)))

818

(base-channel (agp-base-channel agp))

819

(result-channel (solution-generator-channel bgp-generator))

820

(bgp-base-page (make-page 1 base-page-width)))

821

(funcall collector bgp-base-page 0 left-page left-index right-page right-index)

822

(trace-data process-binary-exists (term-value-field bgp-base-page))

823

(trace-data exists-dequeue bgp-base-page (term-value-field bgp-base-page))

824

(channel-put base-channel bgp-base-page)

825

(trace-data exists-dequeue nil nil)

826

(complete-field base-channel)

827

(let ((expression (solution-generator-expression bgp-generator)))

828

(apply (first expression) (rest expression)))

829

(let ((page (channel-get result-channel)))

830

(trace-data exists-continuation (term-value-field page))

831

(not (null page)))))

832

833

834

(defun process-binary-exists (bgp-generator left-page left-index right-page right-index

835

                                                      collector base-page-width)

836

"Compute the exists result given two input field with respective locations by constructing

837

a single-entry input field for the predicate bgp, filling the entry, passing it to the bgp and

838

then interpreting the bgp resut for that single solution.

839

if some result is generated, then the exists predicate succeeds and returns true.

840

Otherwise it returns false."

841

842

(let* ((pattern-function (bgp-generator-pattern-function bgp-generator))

843

(bgp-base-page (make-page 1 base-page-width)))

844

(flet ((exists-dequeue ()

845

(trace-data exists-dequeue (term-value-field bgp-base-page))

846

(shiftf bgp-base-page nil))

847

(exists-continuation (page)

848

(trace-data exists-continuation (term-value-field page))

849

(return-from process-binary-exists (not (null page)))))

850

(funcall collector bgp-base-page 0 left-page left-index right-page right-index)

851

(funcall pattern-function #'exists-continuation #'exists-dequeue)

852

(log-warn "exists match function returned.")

853

nil)))

854

855

856

(defgeneric spocq.e::dynamic-exists (solution-field task)

857

(:documentation "Yield true iff the solution field is not empty.

858

    Delegate the generation process to a clone of the current task which captures the extended bindings.")

859

860

(:method ((exists-field solution-generator) (task task))

861

(let ((exists-expression (solution-generator-expression exists-field))

862

(exists-channel (solution-generator-channel exists-field)))

863

(query-run-in-thread task exists-expression)

864

(let ((exists-page (get-field-page exists-channel)))

865

(when exists-page

866

(release-page exists-page)

867

t))))

868

869

(:method ((field null-generator) task)

870

(declare (ignore field task))

871

nil)

872

873

(:method ((field t) (task t))

874

(log-warn "dynamic-unary-exists: invalid base field ~a ~a" field task)

875

nil))

876

877

878

(defmacro spocq.a:|if| (predicate consequent alternative)

879

"( rdfTerm )

880

The IF form evaluates the first argument, interprets it as a effective boolean value,

881

 then returns the value of consequent if the EBV is true, otherwise it returns the value of alternative.

882

Only one of consequent and alternative is evaluated.

883

 If evaluating the predicate expression raises an error, then an error is raised for the evaluation of the IF expression."

884

885

(setf (variable-opacity (expression-variables predicate)) :transparent)

886

`(if (ebv ,predicate) ,consequent ,alternative))

887

888

889

#+(or)

890

(defmacro spocq.a:|in| (expression expression-list)

891

" ( ( rdfTerm . rdfTerm*) xsd:boolean )

892

 The IN operator tests whether the RDF term on the left-hand side is found in the values of list of expressions on the right-hand side.

893

 The test is done with '=' operator, which tests for the same value, as determined by the operator mapping.

894

A list of zero terms on the right-hand side is legal.

895

 Errors in comparisons cause the IN expression to raise an error if the RDF term being tested is not found elsewhere in the list of terms.

896

897

The IN operator is equivalent to the SPARQL expression:

898

899

(lhs = expression1) || (lhs = expression2) || ...

900

901

NOT IN (...) is equivalent to !(IN (...)).

902

903

as the expression list is _expressions_ it is not quoted.

904

"

905

(setf (variable-opacity (expression-variables expression)) :transparent)

906

(setf (variable-opacity (expression-variables expression-list)) :transparent)

907

`(spocq.e:in ,expression (list ,@expression-list)))

908

909

(defmacro spocq.a:|in| (expression expression-list &environment env)

910

" ( ( rdfTerm . rdfTerm*) xsd:boolean )

911

 The IN operator tests whether the RDF term on the left-hand side is found in the values of list of expressions on the right-hand side.

912

 The test is done with '=' operator, which tests for the same value, as determined by the operator mapping.

913

A list of zero terms on the right-hand side is legal. (with result false)

914

 Errors in comparisons cause the IN expression to raise an error if the RDF term being tested is not found elsewhere in the list of terms.

915

916

The IN operator is equivalent to the SPARQL expression:

917

918

(lhs = expression1) || (lhs = expression2) || ...

919

920

NOT IN (...) is equivalent to !(IN (...)).

921

"

922

(macroexpand-in expression expression-list env))

923

924

(defun macroexpand-in (expression expression-list env)

925

"as the test depends on '=', a comparison of term identities does not always apply.

926

if the test value is computed, the expressions may not be interned values.

927

if a constant value is a number, the term is not sufficient.

928

expand to in-term-number only when term identiy suffices"

929

930

(setf (variable-opacity (expression-variables expression)) :transparent)

931

(setf (variable-opacity (expression-variables expression-list)) :transparent)

932

(let ((expression-expansion (macroexpand-1 expression env)))

933

(if (every #'spocq.e::=-constant-p expression-list)

934

(cond ((field-object-aref-p expression-expansion) ;; autonomous filter expression on a field

935

`(spocq.e::in-term-number (aref ,@(field-object-aref-aref expression-expansion))

936

                                          ',(remove nil (mapcar #'lookup-object-term-number expression-list))))

937

((term-number-object-p expression-expansion) ;; folded filter expression in a bgp

938

`(spocq.e::in-term-number ,(second expression-expansion)

939

                                          ',(remove nil (mapcar #'lookup-object-term-number expression-list))))

940

(t

941

`(spocq.e:in ,expression (list ,@expression-list))))

942

`(spocq.e:in ,expression (list ,@expression-list)))))

943

944

(defun spocq.e:in (value value-list)

945

(loop with condition = nil

946

for test-value in value-list

947

do (handler-case (when (spocq.e:= value test-value) (return t))

948

(error (c) (setf condition c)))

949

finally (progn (when condition (error condition)))))

950

951

(defgeneric spocq.e::=-constant-p (term)

952

(:documentation "return true if a constant and the value will always compare =.

953

This applies for constant, such as strings or iri, but not for numbers are distinct

954

term numbers yield distinct numbers, which can be =")

955

(:method ((term symbol)) (iri-p term))

956

(:method ((term spocq:term)) t)

957

(:method ((term string)) t)

958

(:method ((term spocq:blank-node)) t)

959

(:method ((term t)) nil))

960

961

(defgeneric spocq.e::same-term-constant-p (term)

962

(:documentation "return true iff a constant and the term number suffices to compare.

963

this applies as for =-same-term plus for numbers.")

964

(:method ((term number)) t)

965

(:method ((term symbol)) (iri-p term))

966

(:method ((term spocq:term)) t)

967

(:method ((term string)) t)

968

(:method ((term spocq:blank-node)) t)

969

(:method ((term t)) nil))

970

971

;;; retained as operator to permit tracing

972

(defun spocq.e::in-term-number (value value-list)

973

(when (member value value-list) t))

974

975

(defmacro spocq.a:|notin| (expression expression-list)

976

" ( ( rdfTerm . rdfTerm*) xsd:boolean )

977

NOT IN (...) is equivalent to !(IN (...))."

978

979

`(not (spocq.a:|in| ,expression ,expression-list)))

980

981

982

(defmacro spocq.a:|isIRI| (expression &environment env)

983

"( ( RDFTerm ) xsd:boolean )

984

Returns true if term is an IRI. Returns false otherwise."

985

986

(setf (variable-opacity (expression-variables expression)) :transparent)

987

(let ((expression-expansion (macroexpand-1 expression env)))

988

(if (field-object-aref-p expression-expansion)

989

`(rlmdb:term-is-iri (aref ,@(field-object-aref-aref expression-expansion)))

990

`(spocq.e:iri-p ,expression))))

991

992

(defmacro spocq.a::|isiri| (expression)

993

"Test for URI as for IRI.

994

May need addition check for no-unicode."

995

`(spocq.a:|isIRI| ,expression))

996

997

998

(defmacro spocq.a:|isURI| (expression)

999

"( ( RDFTerm ) xsd:boolean )

1000

isURI is an alternate spelling for the isIRI operator."

1001

1002

;;;??? May need addition check for no-unicode.

1003

`(spocq.a:|isIRI| ,expression))

1004

1005

(defmacro spocq.a::|isuri| (expression)

1006

"Test if the value is an URI. As implemented, permits IRI."

1007

;;;??? May need addition check for no-unicode.

1008

`(spocq.a:|isIRI| ,expression))

1009

1010

(defun spocq.e:iri-p (object)

1011

(iri-p object))

1012

1013

1014

(defmacro spocq.a:|isBlank| (expression &environment env)

1015

"( ( RDFTerm ) xsd:boolean )

1016

Returns true if expression yields a blank node. Returns false otherwise."

1017

1018

(setf (variable-opacity (expression-variables expression)) :transparent)

1019

(let ((expression-expansion (macroexpand-1 expression env)))

1020

(if (field-object-aref-p expression-expansion)

1021

`(shard:term-is-blank-node (aref ,@(field-object-aref-aref expression-expansion)))

1022

`(spocq:blank-node-p ,expression))))

1023

1024

(defmacro spocq.a::|isblank| (expression)

1025

`(spocq.a:|isBlank| ,expression))

1026

1027

1028

(defmacro spocq.a:|isLiteral| (expression &environment env)

1029

"( ( RDFTerm ) xsd:boolean )

1030

Returns true if expression yields a literal. Returns false otherwise."

1031

(macroexpand-is-literal expression env))

1032

1033

(defun macroexpand-is-literal (expression env)

1034

(setf (variable-opacity (expression-variables expression)) :transparent)

1035

(let ((expression-expansion (macroexpand-1 expression env)))

1036

(cond ((field-object-aref-p expression-expansion)

1037

`(rlmdb:term-is-literal (aref ,@(field-object-aref-aref expression-expansion))))

1038

((term-number-object-p expression-expansion)

1039

`(rlmdb:term-is-literal ,(second expression-expansion)))

1040

(t

1041

`(spocq.e:literalp ,expression)))))

1042

1043

(defmacro spocq.a::|isliteral| (expression)

1044

`(spocq.a:|isLiteral| ,expression))

1045

1046

1047

(defmacro spocq.a::|isNumeric| (term)

1048

"( ( RDFTerm ) xsd:boolean )

1049

Returns true if term is a numeric value. Returns false otherwise.

1050

term is numeric if it has an appropriate datatype (see the section Operand Data Types)

1051

 and has a valid lexical form, making it a valid argument to functions and operators taking numeric arguments."

1052

1053

(setf (variable-opacity (expression-variables term)) :transparent)

1054

`(spocq.e:numeric-p ,term))

1055

1056

(defmacro spocq.a::|isnumeric| (expression)

1057

`(spocq.a::|isNumeric| ,expression))

1058

1059

(defgeneric spocq.e:numeric-p (term)

1060

(:documentation "Return true iff the term is numeric")

1061

1062

(:method ((term t)) nil)

1063

(:method ((term number)) t))

1064

1065

1066

(defmacro spocq.a:|lang| (literal &environment env)

1067

"( ( literal ) simpleLiteral )

1068

Returns the language tag of literal, if it has one. It returns '' if literal has no language tag.

1069

Note that the RDF data model does not include literals with an empty language tag."

1070

1071

(macroexpand-lang literal env))

1072

1073

(defun macroexpand-lang (literal env)

1074

(setf (variable-opacity (expression-variables literal)) :transparent)

1075

(let ((expression-expansion (macroexpand-1 literal env)))

1076

(log-debug "lang original expression; ~a ~a" literal expression-expansion)

1077

(if (field-object-aref-p expression-expansion)

1078

`(term-number-lang (aref ,@(field-object-aref-aref expression-expansion)))

1079

`(spocq.e:lang ,literal))))

1080

1081

#+(or) ;;; force complete expansion as the other method crashes

1082

(defun macroexpand-lang (literal env)

1083

(declare (ignore env))

1084

(setf (variable-opacity (expression-variables literal)) :transparent)

1085

`(spocq.e:lang ,literal))

1086

1087

(defgeneric spocq.e:lang (term)

1088

(:method ((term spocq:plain-literal)) (spocq:plain-literal-language-tag term))

1089

(:method ((term spocq:literal)) "")

1090

(:method ((term string)) "")

1091

(:method ((object number)) "")

1092

(:method ((object (eql t))) "")

1093

(:method ((term null)) "")

1094

(:method ((term t))

1095

(spocq.e:argument-type-error :operator 'spocq.a:|lang|

1096

:expected-type '|rdf|:|XMLLiteral|

1097

:datum term)))

1098

1099

1100

(defmacro spocq.a:|langMatches| (language-tag language-range)

1101

"( ( simpleLiteral simpleLiteral ) xsd:boolean )

1102

The function LANGMATCHES Returns true if language-tag (first argument) matches

1103

language-range (second argument) per the basic filtering scheme defined in

1104

[RFC4647] section 3.3.1. language-range is a basic language range per

1105

Matching of Language Tags [RFC4647] section 2.1.

1106

A language-range of "*" matches any non-empty language-tag string."

1107

1108

(setf (variable-opacity (expression-variables language-tag)) :transparent)

1109

(setf (variable-opacity (expression-variables language-range)) :transparent)

1110

`(spocq.e:lang-matches ,language-tag ,language-range))

1111

1112

(defmacro spocq.a::|langmatches| (tag-expression range-expression)

1113

`(spocq.a:|langMatches| ,tag-expression ,range-expression))

1114

1115

(defgeneric spocq.e:lang-matches (tag range)

1116

(:method ((tag null) (range t))

1117

nil)

1118

(:method ((tag symbol) (range t))

1119

(spocq.e:lang-matches (symbol-name tag) range))

1120

(:method ((tag t) (range t))

1121

(when range (spocq.e:lang-matches tag (symbol-name range))))

1122

1123

(:method ((tag string) (range string))

1124

(when (or (string-equal tag range)

1125

(and (not (zerop (length tag))) (equal range "*"))

1126

(let ((tag-length (length tag))

1127

(range-length (length range)))

1128

(and (> tag-length range-length)

1129

(string-equal tag range :end1 range-length)

1130

(char-equal (char tag range-length) #\-))))

1131

t)))

1132

1133

1134

(defmacro spocq.a:|str| (expression)

1135

"( ( RDFTerm ) xsd:string )"

1136

(setf (variable-opacity (expression-variables expression)) :transparent)

1137

`(spocq.e:str ,expression))

1138

1139

1140

(defgeneric spocq.e:str (term)

1141

(:documentation "Convert the term to a string.

1142

If it is a string, disassociate it from an language or type tag.

1143

Otherwise extract its lexical form (ie strip the type) cf {xsd}string")

1144

1145

(:method ((term string))

1146

term)

1147

(:method ((term t))

1148

;; if this is the "lexical form" ?

1149

(spocq.e:string term)))

1150

1151

(macrolet ((def-op ((interface-name implementation-name) (parameter1 parameter2) &rest body)

1152

`(progn (defmacro ,interface-name (,parameter1 ,parameter2)

1153

                        (setf (variable-opacity (expression-variables ,parameter1)) :transparent)

1154

                        (setf (variable-opacity (expression-variables ,parameter2)) :transparent)

1155

(list ',implementation-name ,parameter1 ,parameter2))

1156

(defgeneric ,implementation-name (,parameter1 ,parameter2)

1157

(:method ((,parameter1 string) (,parameter2 string))

1158

,@body)

1159

(:method ((term1 spocq:string) (term2 t))

1160

(,implementation-name (spocq:literal-lexical-form term1) term2))

1161

(:method ((term1 t) (term2 spocq:string))

1162

(,implementation-name term1 (spocq:literal-lexical-form term2)))

1163

(:method ((term1 spocq:plain-literal) (term2 t))

1164

(multiple-value-bind (literal position)

1165

                                               (,interface-name (spocq:literal-lexical-form term1) term2)

1166

(if position

1167

                                (intern-term-aspects :literal literal nil (spocq:plain-literal-language-tag term1))

1168

literal)))

1169

#+(or) ;; as of WD-sparql11-query-20120105 these are incompatible

1170

(:method ((term1 t) (term2 spocq:plain-literal))

1171

(,implementation-name term1 (spocq:literal-lexical-form term2)))

1172

(:method ((term1 t) (term2 spocq:plain-literal))

1173

(spocq.e:argument-type-error :datum (list term1 term2)

1174

                                                       :operator ',interface-name

1175

                                                       :expected-type 'spocq:plain-literal))

1176

(:method ((term1 spocq:plain-literal) (term2 spocq:plain-literal))

1177

(if (string-equal (spocq:plain-literal-language-tag term1)

1178

                                            (spocq:plain-literal-language-tag term2))

1179

(multiple-value-bind (literal position)

1180

                                                   (,implementation-name (spocq:literal-lexical-form term1)

1181

                                                                         (spocq:literal-lexical-form term2))

1182

(if position

1183

                                    (intern-term-aspects :literal literal nil (spocq:plain-literal-language-tag term1))

1184

literal))

1185

(spocq.e:argument-type-error :datum (list term1 term2)

1186

                                                         :operator ',interface-name

1187

                                                         :expected-type 'spocq:plain-literal)))))))

1188

1189

(def-op (spocq.a:|strbefore| spocq.e:substring-before) (arg1 arg2)

1190

"( ( stringLiteral stringLiteral) literal)

1191

The STRBEFORE function corresponds to the XPath fn:substring-before function.

1192

The arguments must be argument compatible otherwise an error is raised.

1193

1194

For compatible arguments, if the lexical part of the second argument occurs as a

1195

substring of the lexical part of the first argument, the function returns a

1196

literal of the same kind as the first argument arg1 (simple literal, plain

1197

literal same language tag, xsd:string). The lexical form of the result is the

1198

substring of the lexical form of arg1 that precedes the first occurrence of the

1199

lexical form of arg2. If the lexical form of arg2 is the empty string, this is

1200

considered to be a match and the lexical form of the result is the empty string.

1201

1202

If there is no such occurrence, an empty simple literal is returned.

1203

(see http://www.w3.org/TR/xpath-functions/#func-substring-before)"

1204

(let ((position (and (> (length arg1) (length arg2)) (search arg2 arg1))))

1205

(values (if position

1206

(subseq arg1 0 position)

1207

"")

1208

position)))

1209

1210

(def-op (spocq.a:|strafter| spocq.e:substring-after) (arg1 arg2)

1211

"( ( stringLiteral stringLiteral) literal)

1212

The STRAFTER function corresponds to the XPath fn:substring-after function.

1213

The arguments must be argument compatible otherwise an error is raised.

1214

1215

For compatible arguments, if the lexical part of the second argument occurs as a

1216

substring of the lexical part of the first argument, the function returns a

1217

literal of the same kind as the first argument arg1 (simple literal, plain

1218

literal same language tag, xsd:string). The lexical form of the result is the

1219

substring of the lexcial form of arg1 that follows the first occurrence of the

1220

lexical form of arg2. If the lexical form of arg2 is the empty string, this is

1221

considered to be a match and the lexical form of the result is the lexical form

1222

of arg1.

1223

1224

If there is no such occurrence, an empty simple literal is returned.

1225

(see http://www.w3.org/TR/xpath-functions/#func-substring-after)"

1226

(let ((position (and (> (length arg1) (length arg2)) (search arg2 arg1))))

1227

(values (if position

1228

(subseq arg1 (+ position (length arg2)))

1229

"")

1230

position))))

1231

1232

(defun spocq.e:make-literal (term &key datatype language)

1233

(typecase term

1234

(string )

1235

(spocq:string (setf term (spocq:literal-lexical-form term)))

1236

(t (error "String must be a simple literal: ~s." term)))

1237

(assert (not (and language datatype)) ()

1238

"Invalid language datatype combination: ~s: ~s ~s" term language datatype)

1239

(intern-term-aspects :literal term datatype language))

1240

1241

1242

(defmacro spocq.a:|strdt| (lexicalForm IRI)

1243

"( (simpleLiteral IRI) literal )

1244

The STRDT function constructs a literal with lexical form and type as specified by the arguments."

1245

1246

(setf (variable-opacity (expression-variables lexicalForm)) :transparent)

1247

(setf (variable-opacity (expression-variables IRI)) :transparent)

1248

`(spocq.e:make-literal ,lexicalForm :datatype ,IRI))

1249

1250

1251

(defmacro spocq.a:|strlang| (expression1 expression2)

1252

"( ( simpleLiteral simpleLiteral) literal )

1253

 The STRLANG function constructs a literal with lexical form and language tag as specified by the arguments."

1254

1255

(setf (variable-opacity (expression-variables expression1)) :transparent)

1256

(setf (variable-opacity (expression-variables expression2)) :transparent)

1257

`(spocq.e:make-literal ,expression1 :language ,expression2))

1258

1259

1260

(defmacro spocq.a:|uuid| ()

1261

"( () iri )

1262

 The UUID function return a fresh IRI from the UUID URN scheme. Each call of UUID() returns a different UUID.

1263

 It must not be the "nil" UUID (all zeroes). The variant and version of the UUID is implementation dependent."

1264

1265

`(spocq.e:uuid))

1266

1267

(defun spocq.e:uuid ()

1268

(intern-uuid (make-v1-uuid-string)))

1269

1270

1271

(defmacro spocq.a:|struuid| ()

1272

"( () simpleLiteral )

1273

Return a string that is the scheme specific part of UUID.

1274

 That is, as a simple literal, the result of generating a UUID, converting to a simple literal and removing the initial urn:uuid:."

1275

1276

`(spocq.e:uuid-string))

1277

1278

(defun spocq.e:uuid-string ()

1279

(make-v1-uuid-string))

1280

1281

1282

(defmacro spocq.a:|substr| (literal startingLoc &optional length)

1283

"( ( stringLiteral xsd:integer ) stringLiteral )

1284

The SUBSTR function corresponds to the XPath fn:substring function and returns a

1285

literal of the same kind (simple literal, literal with language tag, xsd:string

1286

typed literal) as the source input parameter but with a lexical form formed from

1287

the substring of the lexical form of the source.

1288

1289

The arguments startingLoc and length may be derived types of xsd:integer.

1290

1291

The index of the first character in a strings is 1."

1292

1293

(setf (variable-opacity (expression-variables literal)) :transparent)

1294

(setf (variable-opacity (expression-variables startingLoc)) :transparent)

1295

(when length

1296

(setf (variable-opacity (expression-variables length)) :transparent))

1297

`(spocq.e:substring ,literal ,startingLoc ,@(when length (list length))))

1298

1299

1300

(defgeneric spocq.e:substring (term start &optional length)

1301

(:method ((term string) start &optional length)

1302

(let ((term-length (length term))

1303

(effective-start 0)

1304

(effective-end 0))

1305

(cond ((eql start nan)

1306

(return-from spocq.e:substring ""))

1307

             ((infinity-p start) ;; either before the beginning or past the end or combined with infinity

1308

(return-from spocq.e:substring ""))

1309

((< start 1)

1310

(setf start (round start)

1311

effective-start 0))

1312

((numberp start)

1313

(setf start (round start))

1314

(setf effective-start (max 0 (min (1- start) (length term)))))

1315

(t

1316

;; not strictly true, but there's no abstract type.

1317

(invalid-argument-type spocq.a::|substr| start |xsd|:|integer|)))

1318

(cond ((eql length nan)

1319

(return-from spocq.e:substring ""))

1320

((negative-infinity-p length)

1321

(return-from spocq.e:substring ""))

1322

((positive-infinity-p length)

1323

(setf effective-end term-length))

1324

((null length)

1325

(setf effective-end term-length))

1326

((numberp length)

1327

;; combine so as to allow for infinite length

1328

(setf effective-end (min term-length (+ (1- start) (round length)))))

1329

(t

1330

(invalid-argument-type spocq.a::|substr| length |xsd|:|integer|)))

1331

(if (<= effective-end effective-start)

1332

""

1333

(subseq term effective-start effective-end))))

1334

1335

(:method ((term spocq:plain-literal) start &optional length)

1336

(intern-term-aspects :literal (spocq.e:substring (spocq:literal-lexical-form term) start length)

1337

nil (spocq:plain-literal-language-tag term)))

1338

1339

(:method ((term spocq:string) start &optional length)

1340

(spocq.e:substring (spocq:literal-lexical-form term) start length))

1341

1342

(:method ((term t) start &optional length)

1343

(declare (ignore start length))

1344

(invalid-argument-type spocq.a::|substr| term |xsd|:|string|)))

1345

1346

1347

;;; logical operators

1348

;;; !, &&, ||

1349

1350

(defmacro spocq.a:|!| (expression)

1351

`(spocq.e:|!| ,expression))

1352

1353

(defun spocq.e:|!| (object)

1354

(if (ebv object) spocq.a:|false| spocq.a:|true|))

1355

1356

1357

;;; dydra-265: take care to use explicit handler-case rather than multiple-value-bind/ignore-errors

1358

(defmacro spocq.a:\|\| (left right)

1359

"( xsd:boolean )

1360

The || operator returns a logical OR of left and right.

1361

Note that logical-or operates on the effective boolean value of its arguments.

1362

1363

XQuery defines that an IF form need not evaluate an unselected alternative. It says nothing about

1364

the semantics for logical operators. This implementation handles the two expresions the same."

1365

1366

(let ((term-op (gensym)) (condition (gensym)))

1367

`(flet ((,term-op () (ebv ,right)))

1368

(or (handler-case (ebv ,left)

1369

(error (,condition) (or (,term-op) (error ,condition))))

1370

(,term-op)))))

1371

1372

1373

(defmacro spocq.a:|&&| (&optional term1 term2 &rest other-terms)

1374

"( xsd:boolean )

1375

The && operator returns a logical AND of left and right.

1376

Note that logical-and operates on the effective boolean value of its arguments.

1377

1378

XQuery defines that an IF form need not evaluate an unselected alternative. It says nothing about

1379

the semantics for logical operators. This implementation handles the two expresions the same.

1380

1381

wrt errors:

1382

 A logical-and that encounters an error on only one branch will return an error if the other branch is TRUE

1383

and FALSE if the other branch is FALSE.

1384

A logical-or or logical-and that encounters errors on both branches will produce either of the errors.

1385

"

1386

1387

(if term1

1388

(if term2

1389

(if other-terms

1390

`(spocq.a:|&&| ,term1 (spocq.a:|&&| ,term2 ,@other-terms))

1391

(let ((term-op (gensym)) (condition (gensym)))

1392

`(flet ((,term-op () (ebv ,term2)))

1393

(and (handler-case (ebv ,term1)

1394

(error (,condition) (and (,term-op) (error ,condition))))

1395

(,term-op)))))

1396

`(ebv ,term1))

1397

t))

1398

1399

#+(or) ;; test handler overhead. for sp2b-250k,q6 w/ handler was 112s, w/o 107 for 156M

1400

(defmacro spocq.a:|&&| (&optional term1 term2 &rest other-terms)

1401

   "XQuery defines that an 'if' form need not evaluate an unselected alternative. It says nothing about

1402

necessity for 'or'. This implementation handles the two expresions the same."

1403

1404

(if term1

1405

(if term2

1406

(if other-terms

1407

`(spocq.a:|&&| ,term1 (spocq.a:|&&| ,term2 ,@other-terms))

1408

`(and (ebv ,term1) (ebv ,term2)))

1409

`(ebv ,term1))

1410

t))

1411

1412

1413

;;; order predicates

1414

;;;

1415

;;; the SPARQL spec delegates the implementation to the xpath

1416

;;; [spec](http://www.w3.org/TR/xpath-functions/#func-compare), but makes no reference

1417

;;; of the possible implication of language tage on collation.

1418

;;;

1419

;;; The SPARQL spec also makes no reference to the effect of types and tags on

1420

;;; order

1421

;;;

1422

;;; "Pairs of IRIs are ordered by comparing them as simple literals"

1423

;;; literal : can be types or tagged

1424

;;; plain literal : can be tagged

1425

;;; simple literal : neither typed nor tagged

1426

1427

(:documentation "About identity"

1428

"SPARQL defines two kinds of equivalence among terms: identity and equality.

1429

The operator 'sameTerm' tests for identity. The operator 'termEqual' (or its lexical designator '=')

1430

tests for equality. The latter semantics differ from the former particularly for literals

1431

and for unsupported datatypes.

1432

  The identity predicate former permits unrestricted comparisons, but the equality test signals an error in

1433

cases where a literal datatype is unknown. the implemented logic is:

1434

- if both are string literals, but one or both types are unknown, signal an error

1435

- if one is parsed, but the other is not, signal an error.

1436

1437

An implementation-specific efficiency concern is that equality of 'internables' is tested with 'eq'

1438

rather than the less restrictive 'equals'

1439

  This applies to blank nodes and iri, which are interned integral with parsing and with retrieval from

1440

  the store. This needs to take the different data flows in query processing into account. A parsed query

1441

  is modeled with interned lisp objects, which are projected onto store term identifiers/numbers on-the-fly,

1442

  as the query bgp's or property paths are procesed. These identifiers will agree with those which pass back

1443

  out from the store, but as the solution fields are represented as integer arrays if the query includes filter

1444

  or aggregation operations, any values intered on the result path must be unified with constraining values

1445

which can appear in the query expression.")

1446

1447

1448

(defparameter *enable-term-compare* t)

1449

1450

(defmacro def-spocq-predicate (name lambda-list &rest methods)

1451

(let* ((algebra-name (if (consp name) (first name)

1452

(or (find-symbol (symbol-name name) :spocq.a)

1453

(error "Invalid operator: ~a." name))))

1454

(evaluation-name (if (consp name) (second name)

1455

(or (find-symbol (symbol-name name) :spocq.e)

1456

(error "Invalid operator: ~a." name))))

1457

(just-methods (remove :documentation methods :key #'first))

1458

(types (mapcar #'second (mapcar #'first (mapcar #'second just-methods))))

1459

(documentation `(:documentation

1460

                           ,(format nil "Predicate operator implementation for '~a', defined on ~a.~@[~%~%~a~]"

1461

algebra-name types

1462

(second (assoc :documentation methods))))))

1463

`(defgeneric ,evaluation-name ,lambda-list

1464

,documentation

1465

,@(unless (find-if #'(lambda (method)

1466

(and (eq (first method) :method)

1467

                                    (= 2 (count t (mapcar 'second (second method))))))

1468

methods)

1469

`((:method ((term1 t) (term2 t))

1470

(predicate-argument-type-error ',algebra-name term1 term2 ',(cons 'or types)))))

1471

,@just-methods)))

1472

1473

(defun inline-term-number-form (expression env)

1474

(let ((expansion (macroexpand-1 expression env)))

1475

(cond ((field-object-aref-p expansion)

1476

`(aref ,@(field-object-aref-aref expansion)))

1477

((field-vector-object-aref-p expansion)

1478

`(aref ,@(field-vector-object-aref-aref expansion)))

1479

((term-number-object-p expansion)

1480

(second expansion))

1481

((variable-p expansion) ; just in case

1482

nil)

1483

((not (consp expansion))

1484

;; attempt to resolve constants

1485

(repository-object-term-number *transaction* expansion)))))

1486

1487

1488

(defmacro spocq.a:|sameTerm| (term1 term2 &environment env)

1489

"( (rdfTerm rdfTerm) xsd:boolean )

1490

The function SAMETERM returns TRUE if term1 and term2 are the same RDF term as

1491

defined in Resource Description Framework (RDF): Concepts and Abstract Syntax [CONCEPTS];

1492

returns FALSE otherwise."

1493

(macroexpand-same-term term1 term2 env))

1494

1495

(defun macroexpand-same-term (term1 term2 env)

1496

(let ((term1-expansion (inline-term-number-form term1 env))

1497

(term2-expansion (inline-term-number-form term2 env)))

1498

(if (and term1-expansion term2-expansion)

1499

`((lambda (id1 id2)

1500

(declare (type fixnum id1 id2))

1501

(and (= id1 id2) (not (= id1 +null-term-id+)) (not (= id2 +null-term-id+))))

1502

,term1-expansion ,term2-expansion)

1503

`(spocq.e:same-term ,term1 ,term2))))

1504

1505

(defgeneric spocq.e:same-term (term1 term2)

1506

(:documentation "Return true iff the two terms are identical.

1507

This devolves to a type-specific test for native types - eg. iri variations and numbers, and

1508

the tripartite string/tag/datatype test for literals. Opaque terms entail an equal test.")

1509

1510

(:method ((term1 spocq:blank-node) (term2 spocq:blank-node))

1511

(eq term1 term2))

1512

(:method ((term1 spocq:iri) (term2 spocq:iri))

1513

(eq term1 term2))

1514

(:method ((term1 string) (term2 string))

1515

(equal term1 term2))

1516

(:method ((term1 symbol) (term2 symbol))

1517

(eq term1 term2))

1518

(:method ((term1 number) (term2 number))

1519

(equal term1 term2))

1520

1521

(:method ((term1 t) (term2 t))

1522

(equalp term1 term2)))

1523

1524

1525

(defmacro spocq.a::|typep| (term type-iri &environment env)

1526

"( xsd:boolean )

1527

Return true iff the type of the given term is the given type.

1528

Where constants are involved, implement as a termnumber comparison for the iri and the term type."

1529

(macroexpand-typep term type-iri env))

1530

1531

(defun macroexpand-typep (term type-iri env)

1532

(labels ((term-number-expression (expression)

1533

(if (iri-p expression)

1534

(object-term-number expression)

1535

(let ((expansion (macroexpand-1 expression env)))

1536

(cond ((field-object-aref-p expansion)

1537

`(aref ,@(field-object-aref-aref expansion)))

1538

((term-number-object-p expansion)

1539

(second expansion))

1540

(t

1541

nil)))))

1542

(term-datatype-iri-term-number-expression (expression)

1543

(let ((term-number-expression (term-number-expression expression)))

1544

(when term-number-expression

1545

`(dydra-ndk:term-datatype-id ,term-number-expression)))))

1546

(or (let ((type-iri-term-number-expression (term-number-expression type-iri)))

1547

(when type-iri-term-number-expression

1548

             (let ((term-datatype-iri-term-number-expression (term-datatype-iri-term-number-expression term)))

1549

(when term-datatype-iri-term-number-expression

1550

`(let ((.tditn. ,term-datatype-iri-term-number-expression)

1551

(.titn. ,type-iri-term-number-expression))

1552

                    (if (= .titn. ,(symbol-term-id '|http://www.w3.org/2001/XMLSchema|:|anyURI|))

1553

(rlmdb:term-is-iri ,(term-number-expression term))

1554

(= .tditn. .titn.)))))))

1555

`(spocq.e:|=| (spocq.e:data-type ,term) ,type-iri))))

1556

1557

(defun datatype-expression-p (form)

1558

(and (consp form)

1559

(eq (first form) 'spocq.a:|datatype|)))

1560

1561

1562

(defmacro spocq.a:|=| (term1 term2 &environment env)

1563

"( xsd:boolean )

1564

The '=' operator returns TRUE if term1 and term2 are the same RDF term as defined in

1565

Resource Description Framework (RDF): Concepts and Abstract Syntax [CONCEPTS];

1566

produces a type error if the arguments are both literal but are not the same RDF term;

1567

returns FALSE otherwise. term1 and term2 are the same if any of the following is true:

1568

- term1 and term2 are equivalent IRIs as defined in 6.4 RDF URI References of [CONCEPTS].

1569

- term1 and term2 are equivalent literals as defined in 6.5.1 Literal Equality of [CONCEPTS].

1570

- term1 and term2 are the same blank node as described in 6.6 Blank Nodes of [CONCEPTS].

1571

"

1572

(macroexpand-= term1 term2 env))

1573

1574

1575

(defun macroexpand-= (expression-1 expression-2 env)

1576

(setf (variable-opacity (expression-variables expression-1)) :transparent)

1577

(setf (variable-opacity (expression-variables expression-2)) :transparent)

1578

(let ((term1-expansion (inline-term-number-form expression-1 env))

1579

(term2-expansion (inline-term-number-form expression-2 env)))

1580

(cond ((and *enable-term-compare* term1-expansion term2-expansion)

1581

;; iff the comparison is of two term numbers, then delegate to the ndk to

1582

;; compare in that domain

1583

`(let* ((term-number-1 ,term1-expansion)

1584

(term-number-2 ,term2-expansion)

1585

(order (and (integerp term-number-1) (integerp term-number-2)

1586

                                (dydra-ndk:term-compare term-number-1 term-number-2))))

1587

(ecase order

1588

(0 t)

1589

((1 -1) nil)

1590

((nil) (spocq.e:|=| ,expression-1 ,expression-2)))))

1591

;; otherwise if it involves operators which can be optimized, try that

1592

((and (or term1-expansion (iri-p expression-1)) (datatype-expression-p expression-2))

1593

`(spocq.a::|typep| ,(second expression-2) ,expression-1))

1594

((and (or term2-expansion (iri-p expression-2)) (datatype-expression-p expression-1))

1595

`(spocq.a::|typep| ,(second expression-1) ,expression-2))

1596

(t

1597

`(spocq.e:|=| ,expression-1 ,expression-2)))))

1598

1599

1600

;; indirection function was slower than the generic alone

1601

#+(or)

1602

(defun spocq.e:= (term1 term2)

1603

(if (eq (type-of term1) (type-of term2))

1604

(equal term1 term2)

1605

(generic-equals term1 term2)))

1606

1607

(defparameter *heterogeneous-types-are-incommensurable* nil

1608

"see 17.4.1.7 RDFterm-equal. does

1609

produces a type error if the arguments are both literal but are not the same RDF term

1610

intend 'term' or type'?")

1611

1612

(defun unsupported= (term1 term2)

1613

;; even with mf:KnownTypesDefault2Neq

1614

(if *enable-sort-precedence*

1615

nil

1616

(spocq.e::incommensurable-arguments-error :operator 'spocq.a:= :datum (list term1 term2))))

1617

1618

(def-spocq-predicate = (term1 term2)

1619

(:documentation "Predicate operator implementation for '=', defined on all terms,

1620

but signals an exception for un-equal literals. See

1621

- http://www.w3.org/TR/rdf-sparql-query/#func-RDFterm-equal

1622

- http://www.w3.org/TR/rdf-concepts/#section-Literal-Equality

1623

- http://www.w3.org/TR/rdf-sparql-query/#OperatorMapping

1624

     for discussions of equality and the results / errors. The termEqual definition prescribes errors for

1625

     unequal literals, while the operator mapping table prescribes for string types to compare just the

1626

string. The logic here uses spocq:non-literal to excluse the cases where no error can occur and

1627

otherwise signals an error for unequal unsupported-typed literals.

1628

1629

nb. there are no methods for the term structure type respective native types

1630

nb. temporal methods are defined elsewhere, whereby they are type-specific.")

1631

1632

(:method ((term1 number) (term2 number))

1633

(= term1 term2))

1634

(:method ((term1 ratio) (term2 number))

1635

(= (if (= (denominator term1) 1) (numerator term1) term1) term2))

1636

(:method ((term1 number) (term2 ratio))

1637

(= term1 (if (= (denominator term2) 1) (numerator term2) term2)))

1638

(:method ((term1 ratio) (term2 ratio))

1639

(= term1 term2))

1640

(:method ((term1 spocq:blank-node) (term2 spocq:blank-node))

1641

(eq term1 term2))

1642

(:method ((term1 spocq:iri) (term2 spocq:iri))

1643

(eq term1 term2))

1644

(:method ((term1 symbol) (term2 symbol))

1645

(eq term1 term2))

1646

(:method ((term1 spocq:literal) (term2 spocq:literal))

1647

;; with mf:KnownTypesDefault2Neq, this does not signal an error

1648

(equalp term1 term2))

1649

(:method ((term1 string) (term2 string))

1650

(equal term1 term2))

1651

(:method ((term1 spocq:plain-literal) (term2 spocq:plain-literal))

1652

(when (equalp (spocq::plain-literal-language-tag term1)

1653

(spocq::plain-literal-language-tag term2))

1654

;; perform collation-dependent comparison as equality can apply between

1655

;; distinct lisp characters

1656

(let* ((order (dydra-ndk:string-collate (spocq::plain-literal-lexical-form term1)

1657

                                               (spocq::plain-literal-lexical-form term2)

1658

                                               (spocq::plain-literal-language-tag term1))))

1659

(case order

1660

(0 t)

1661

(t nil)))))

1662

(:method ((term1 string) (term2 spocq:plain-literal))

1663

;; mf:KnownTypesDefault2Neq

1664

nil)

1665

(:method ((term1 spocq:plain-literal) (term2 string))

1666

;; mf:KnownTypesDefault2Neq

1667

nil)

1668

1669

(:method ((term1 spocq:non-literal) (term2 t))

1670

nil)

1671

(:method ((term1 t) (term2 spocq:non-literal))

1672

nil)

1673

(:method ((term1 spocq:term) (term2 spocq:term))

1674

;; allow identical terms

1675

(if (eq (type-of term1) (type-of term2))

1676

(equalp term1 term2)

1677

(call-next-method)))

1678

1679

;; enforce limited commensurability to unsupported domains

1680

(:method ((term1 spocq:unsupported-typed-literal) (term2 spocq:literal))

1681

(when *heterogeneous-types-are-incommensurable* (unsupported= term1 term2)))

1682

(:method ((term1 spocq:unsupported-typed-literal) (term2 number))

1683

(unsupported= term1 term2))

1684

(:method ((term1 spocq:unsupported-typed-literal) (term2 string))

1685

(unsupported= term1 term2))

1686

(:method ((term1 spocq:literal) (term2 spocq:unsupported-typed-literal))

1687

(when *heterogeneous-types-are-incommensurable* (unsupported= term1 term2)))

1688

(:method ((term1 number) (term2 spocq:unsupported-typed-literal))

1689

(unsupported= term1 term2))

1690

(:method ((term1 string) (term2 spocq:unsupported-typed-literal))

1691

(unsupported= term1 term2))

1692

(:method ((term1 spocq:unsupported-typed-literal) (term2 spocq:unsupported-typed-literal))

1693

(cond ((equal (SPOCQ:UNSUPPORTED-TYPED-LITERAL-datatype-uri term1)

1694

(SPOCQ:UNSUPPORTED-TYPED-LITERAL-datatype-uri term2))

1695

(or (equal (spocq:literal-lexical-form term1) (spocq:literal-lexical-form term2))

1696

(unsupported= term1 term2)))

1697

(t ; *heterogeneous-types-are-incommensurable*

1698

            ;; this is required in order to get <http://www.w3.org/2001/sw/DataAccess/tests/data-r2/open-world/manifest#open-eq-08>

1699

            ;; to yield the required result, but it is inconsistent with the logic required for literals of

1700

;; known and unknown combination, above

1701

(unsupported= term1 term2))

1702

(t

1703

nil)))

1704

1705

(:method ((term1 t) (term2 t))

1706

(cond (*heterogeneous-types-are-incommensurable*

1707

(unsupported= term1 term2))

1708

(t

1709

nil))))

1710

1711

 ;; (compute-applicable-methods #'spocq.e::= (list (SPOCQ:make-UNSUPPORTED-TYPED-LITERAL "xyz" <http://example/unknown>) (SPOCQ:make-PLAIN-LITERAL "xyz" "EN")))

1712

(defmacro spocq.a:|!=| (term1 term2)

1713

"( ( numeric numeric ) xsd:boolean)"

1714

`(not (spocq.a:|=| ,term1 ,term2)))

1715

1716

(defun spocq.e:|!=| (term1 term2)

1717

(not (spocq.e:= term1 term2)))

1718

1719

1720

1721

(defmacro spocq.a:|<| (arg1 arg2 &environment env)

1722

"( ( numeric numeric ) xsd:boolean)

1723

The function '<' compares the two arguments and returns true iff arg1 is strictly less than arg2.

1724

The implemented comparison is contingent upon whether it can be determined that the arguments are

1725

constants, and then if so, strings with language tages. In that case delegate to the store's operator

1726

for collation-sequence dependent order. In other cases, retrieve the terms and then continue

1727

with those values as arguments."

1728

1729

(macroexpand-< arg1 arg2 env))

1730

1731

1732

(defun macroexpand-< (expression-1 expression-2 env)

1733

(setf (variable-opacity (expression-variables expression-1)) :transparent)

1734

(setf (variable-opacity (expression-variables expression-2)) :transparent)

1735

(let ((term1-expansion (inline-term-number-form expression-1 env))

1736

(term2-expansion (inline-term-number-form expression-2 env)))

1737

(cond ((and *enable-term-compare* term1-expansion term2-expansion)

1738

`(let* ((term-number-1 ,term1-expansion)

1739

(term-number-2 ,term2-expansion)

1740

(order (and (integerp term-number-1) (integerp term-number-2)

1741

                                (dydra-ndk:term-compare term-number-1 term-number-2))))

1742

(ecase order

1743

(-1 t)

1744

((0 1) nil)

1745

((nil) (spocq.e:|<| ,expression-1 ,expression-2)))))

1746

(t

1747

`(spocq.e:|<| ,expression-1 ,expression-2)))))

1748

1749

(def-spocq-predicate spocq.e:< (term1 term2)

1750

(:documentation "Compare the term values and return true iff the first preceeds the second.

1751

     The specification limits the function's definition to a subset of the type combination and provides

1752

a limited partial order when sorting (http://www.w3.org/TR/sparql11-query/#modOrderBy).

1753

     This implementation defines additional combinations (http://www.w3.org/TR/sparql11-query/#operatorExtensibility)

1754

and defines a partial order under all conditions.")

1755

#+(or)

1756

(:method :around ((term1 t) (term2 t))

1757

     "a prospective method which delegats to the extrnal libaray in all cases for which the term numbers are known

1758

would need empirical results before it should be enabled."

1759

(let* ((term-number-1 (object-term-number term1))

1760

(term-number-2 (object-term-number term2))

1761

(order (and (integerp term-number-1) (integerp term-number-2)

1762

(dydra-ndk:term-compare term-number-1 term-number-2))))

1763

(case order

1764

(-1 t)

1765

((0 1 nil) nil))))

1766

1767

(:method ((term1 number) (term2 number))

1768

(when (< term1 term2) t))

1769

(:method ((term1 ratio) (term2 number))

1770

(when (< (if (= (denominator term1) 1) (numerator term1) term1) term2) t))

1771

(:method ((term1 number) (term2 ratio))

1772

(when (< term1 (if (= (denominator term2) 1) (numerator term2) term2)) t))

1773

(:method ((term1 ratio) (term2 ratio))

1774

(when (< term1 term2) t))

1775

(:method ((term1 string) (term2 string))

1776

(when (string< term1 term2) t))

1777

(:method ((term1 spocq:boolean) (term2 spocq:boolean))

1778

(let ((value1 (spocq:boolean-value term1))

1779

(value2 (spocq:boolean-value term2)))

1780

;; false preceeds

1781

(unless (eq value1 value2)

1782

(null value1))))

1783

(:method ((term1 spocq:plain-literal) (term2 spocq:plain-literal))

1784

"Extend the definition to apply the language-specific collating sequence to combinations

1785

for which the language tags match."

1786

(let ((lt1 (spocq::plain-literal-language-tag term1))

1787

(lt2 (spocq::plain-literal-language-tag term2)))

1788

(if (and (stringp lt1) (stringp lt2) (string-equal lt1 lt2))

1789

(case (dydra-ndk::string-collate (spocq::plain-literal-lexical-form term1)

1790

                                            (spocq::plain-literal-lexical-form term2)

1791

                                            (spocq::plain-literal-language-tag term1))

1792

(-1 t)

1793

(t nil))

1794

(call-next-method))))

1795

(:method ((term1 spocq:blank-node) (term2 spocq:blank-node))

1796

(when (string< (spocq:blank-node-label term1) (spocq:blank-node-label term2)) t))

1797

(:method ((term1 symbol) (term2 symbol))

1798

(when (string< (symbol-uri-namestring term1) (symbol-uri-namestring term2)) t))

1799

(:method ((term1 spocq:iri) (term2 spocq:iri))

1800

(when (string< (spocq:iri-lexical-form term1) (spocq:iri-lexical-form term2)) t))

1801

1802

(:method ((term1 spocq:unbound-variable) (term2 spocq:unbound-variable))

1803

;; at least to test outer join solutions

1804

(when (string< (spocq:unbound-variable-name term1) (spocq:unbound-variable-name term2)) t))

1805

(:method ((term1 t) (term2 t))

1806

"Provide a base definition which applies the partial order from sorting."

1807

(if *enable-sort-precedence*

1808

(case term1

1809

((nil t) (spocq.e:< (if term1 spocq.a:|true| spocq.a:|false|) term2))

1810

(t (case term2

1811

((nil t) (spocq.e:< term1 (if term2 spocq.a:|true| spocq.a:|false|)))

1812

(t

1813

(when (< (type-sort-precedence term1) (type-sort-precedence term2)) t)))))

1814

(spocq.e::incommensurable-arguments-error :operator 'spocq.a:< :datum (list term1 term2)))))

1815

1816

1817

(defmacro spocq.a:> (expression-1 expression-2)

1818

"( ( numeric numeric ) xsd:boolean)"

1819

`(spocq.a:< ,expression-2 ,expression-1))

1820

1821

(defun spocq.e:> (expression-1 expression-2)

1822

(spocq.e:< expression-2 expression-1))

1823

1824

1825

(defmacro spocq.a:|<=| (expression-1 expression-2 &environment env)

1826

"( ( numeric numeric ) xsd:boolean)

1827

The function '<' compares the two arguments and returns true iff arg1 is less or equal to arg2.

1828

 The implemented comparison is comparison contingent upon whether it can be determined that the arguments are

1829

constants, and then if so, strings with language tages. In that case delegate to the store's operator

1830

for collation-sequence dependent order. In other cases, instantiate the terms and then continue

1831

with those values as arguments."

1832

1833

(macroexpand-<= expression-1 expression-2 env))

1834

1835

(defun macroexpand-<= (expression-1 expression-2 env)

1836

(setf (variable-opacity (expression-variables expression-1)) :transparent)

1837

(setf (variable-opacity (expression-variables expression-2)) :transparent)

1838

(let ((term1-expansion (inline-term-number-form expression-1 env))

1839

(term2-expansion (inline-term-number-form expression-2 env)))

1840

(cond ((and *enable-term-compare* term1-expansion term2-expansion)

1841

`(let* ((term-number-1 ,term1-expansion)

1842

(term-number-2 ,term2-expansion)

1843

(order (and (integerp term-number-1) (integerp term-number-2)

1844

                                (dydra-ndk:term-compare term-number-1 term-number-2))))

1845

(ecase order

1846

((-1 0) t)

1847

(1 nil)

1848

((nil) (spocq.e:|<=| ,expression-1 ,expression-2)))))

1849

(t

1850

`(spocq.e:|<=| ,expression-1 ,expression-2)))))

1851

1852

1853

(def-spocq-predicate spocq.e:|<=| (term1 term2)

1854

#+(or)

1855

(:method :around ((term1 t) (term2 t))

1856

     "a prospective method which delegats to the extrnal libaray in all cases for which the term numbers are known

1857

would need empirical results before it should be enabled."

1858

(let* ((term-number-1 (object-term-number term1))

1859

(term-number-2 (object-term-number term2))

1860

(order (and (integerp term-number-1) (integerp term-number-2)

1861

(dydra-ndk:term-compare term-number-1 term-number-2))))

1862

(case order

1863

(-1 t)

1864

((0 1 nil) nil))))

1865

(:method ((term1 number) (term2 number))

1866

(when (<= term1 term2) t))

1867

(:method ((term1 ratio) (term2 number))

1868

(when (<= (if (= (denominator term1) 1) (numerator term1) term1) term2) t))

1869

(:method ((term1 number) (term2 ratio))

1870

(when (<= term1 (if (= (denominator term2) 1) (numerator term2) term2)) t))

1871

(:method ((term1 ratio) (term2 ratio))

1872

(when (<= term1 term2) t))

1873

(:method ((term1 string) (term2 string))

1874

(when (string<= term1 term2) t))

1875

(:method ((term1 spocq:plain-literal) (term2 spocq:plain-literal))

1876

"Extend the definition to apply the language-specific collating sequence to combinations

1877

for which the language tags match."

1878

(let ((lt1 (spocq::plain-literal-language-tag term1))

1879

(lt2 (spocq::plain-literal-language-tag term2)))

1880

(if (and (stringp lt1) (stringp lt2) (string-equal lt1 lt2))

1881

(case (dydra-ndk::string-collate (spocq::plain-literal-lexical-form term1)

1882

                                            (spocq::plain-literal-lexical-form term2)

1883

                                            (spocq::plain-literal-language-tag term1))

1884

((-1 0) t)

1885

(t nil))

1886

(call-next-method))))

1887

(:method ((term1 spocq:boolean) (term2 spocq:boolean))

1888

(let ((value1 (spocq:boolean-value term1))

1889

(value2 (spocq:boolean-value term2)))

1890

(or (eq value1 value2)

1891

(spocq.e:< term1 term2))))

1892

(:method ((term1 spocq:blank-node) (term2 spocq:blank-node))

1893

(if *enable-sort-precedence*

1894

(when (string<= (spocq:blank-node-label term1) (spocq:blank-node-label term2)) t)

1895

(call-next-method)))

1896

(:method ((term1 symbol) (term2 symbol))

1897

(if *enable-sort-precedence*

1898

(when (string<= (symbol-uri-namestring term1) (symbol-uri-namestring term2)) t)

1899

(call-next-method)))

1900

(:method ((term1 spocq:iri) (term2 spocq:iri))

1901

"GIven two iri, compare the namestrings"

1902

(if *enable-sort-precedence*

1903

(when (string<= (spocq:iri-lexical-form term1) (spocq:iri-lexical-form term2)) t)

1904

(call-next-method)))

1905

1906

(:method ((term1 spocq:unbound-variable) (term2 spocq:unbound-variable))

1907

;; at least to test outer join solutions

1908

(if *enable-sort-precedence*

1909

(when (string<= (spocq:unbound-variable-name term1) (spocq:unbound-variable-name term2)) t)

1910

(call-next-method)))

1911

(:method ((term1 t) (term2 t))

1912

"Provide a base definition which applies the partial order from sorting."

1913

(if *enable-sort-precedence*

1914

(case term1

1915

((nil t) (spocq.e:<= (if term1 spocq.a:|true| spocq.a:|false|) term2))

1916

(t (case term2

1917

((nil t) (spocq.e:<= term1 (if term2 spocq.a:|true| spocq.a:|false|)))

1918

(t

1919

(when (<= (type-sort-precedence term1) (type-sort-precedence term2)) t)))))

1920

(spocq.e::incommensurable-arguments-error :operator 'spocq.a:<= :datum (list term1 term2)))))

1921

1922

1923

(defmacro spocq.a:>= (expression-1 expression-2)

1924

"( ( numeric numeric ) xsd:boolean)"

1925

`(spocq.a:<= ,expression-2 ,expression-1))

1926

1927

(defun spocq.e:>= (expression-1 expression-2)

1928

(spocq.e:<= expression-2 expression-1))

1929

1930

1931

(defmacro spocq.a::|max| (expression1 expression2)

1932

"( ( numeric numeric ) numeric)"

1933

`(spocq.e:max ,expression1 ,expression2))

1934

1935

(defun spocq.e:max (term1 term2)

1936

(if (spocq.e:|>| term2 term1) term2 term1))

1937

1938

(defmacro spocq.a::|min| (expression1 expression2)

1939

`(spocq.e:min ,expression1 ,expression2))

1940

1941

(defun spocq.e:min (term1 term2)

1942

"( ( numeric numeric ) numeric)"

1943

(if (spocq.e:|>| term1 term2) term2 term1))

1944

1945

1946

;;; arithmetic

1947

1948

(defgeneric spocq.e::number (term)

1949

(:method ((object number))

1950

object)

1951

(:method ((object spocq:boolean))

1952

(spocq.e:integer object))

1953

(:method ((object string))

1954

(if (every #'digit-char-p object)

1955

(spocq.e:integer object)

1956

(spocq.e:float object))))

1957

1958

(defmacro spocq.a:|+| (expression-1 &optional expression-2)

1959

"( ( numeric numeric? ) numeric)"

1960

(setf (variable-opacity (expression-variables expression-1)) :transparent)

1961

(when expression-2

1962

(setf (variable-opacity (expression-variables expression-2)) :transparent))

1963

(if expression-2

1964

`(spocq.e:|+| ,expression-1 ,expression-2)

1965

`(spocq.e:unary-plus ,expression-1)))

1966

1967

1968

(defgeneric spocq.e:unary-plus (object)

1969

(:method ((object number))

1970

object)

1971

(:method ((object t))

1972

(spocq.e::number object)))

1973

1974

(defgeneric spocq.e:|+| (term1 term2)

1975

(:method ((term1 integer) (term2 integer))

1976

(+ term1 term2))

1977

(:method ((term1 number) (term2 number))

1978

(if (or (eql term1 NAN) (eql term2 NAN))

1979

NAN

1980

(if (or (eql term1 +INF) (eql term1 -INF))

1981

(if (or (eql term2 +INF) (eql term2 -INF))

1982

NAN

1983

term1)

1984

(if (or (eql term2 +INF) (eql term2 -INF))

1985

term2

1986

(+ term1 term2)))))

1987

;; casting

1988

(:method ((object t) (term2 t))

1989

(spocq.e:|+| (spocq.e::number object) term2))

1990

(:method ((term1 number) (object t))

1991

(spocq.e:|+| term1 (spocq.e::number object))))

1992

1993

1994

(defmacro spocq.a:|-| (expression-1 &optional expression-2)

1995

"( ( numeric numeric? ) numeric)"

1996

(macroexpand-- expression-1 expression-2))

1997

1998

(defun macroexpand-- (expression-1 expression-2)

1999

(setf (variable-opacity (expression-variables expression-1)) :transparent)

2000

(when expression-2

2001

(setf (variable-opacity (expression-variables expression-2)) :transparent))

2002

(if expression-2

2003

`(spocq.e:|-| ,expression-1 ,expression-2)

2004

`(spocq.e:unary-minus ,expression-1)))

2005

2006

2007

(defgeneric spocq.e:unary-minus (object)

2008

(:method ((object integer))

2009

(- object))

2010

(:method ((object float))

2011

(cond

2012

((= object NAN) NAN)

2013

((= object +INF) -INF)

2014

((= object -INF) +INF)))

2015

(:method ((object t))

2016

(spocq.e:unary-minus (spocq.e::number object))))

2017

2018

2019

(defgeneric spocq.e:|-| (term1 term2)

2020

(:method ((term1 integer) (term2 integer))

2021

(- term1 term2))

2022

(:method ((term1 number) (term2 number))

2023

(if (or (eql term1 NAN) (eql term2 NAN))

2024

NAN

2025

(if (or (eql term1 +INF) (eql term1 -INF))

2026

(if (or (eql term2 +INF) (eql term2 -INF))

2027

NAN

2028

term1)

2029

(if (or (eql term2 +INF) (eql term2 -INF))

2030

(spocq.e:unary-minus term2)

2031

(- term1 term2)))))

2032

;; casting

2033

(:method ((object t) (term2 t))

2034

(spocq.e:|-| (spocq.e::number object) term2))

2035

(:method ((term1 number) (object t))

2036

(spocq.e:|-| term1 (spocq.e::number object))))

2037

2038

2039

(defmacro spocq.a:|*| (expression-1 expression-2)

2040

"( ( numeric numeric ) numeric )"

2041

(setf (variable-opacity (expression-variables expression-1)) :transparent)

2042

(setf (variable-opacity (expression-variables expression-2)) :transparent)

2043

`(spocq.e:|*| ,expression-1 ,expression-2))

2044

2045

(defgeneric spocq.e:|*| (term1 term2)

2046

(:method ((term1 number) (term2 number))

2047

(if (or (eql term1 NAN) (eql term2 NAN))

2048

NAN

2049

(* term1 term2)))

2050

(:method ((term1 float) (term2 float))

2051

(if (or (eql term1 NAN) (eql term2 NAN))

2052

NAN

2053

(if (or (eql term1 +INF) (eql term1 -INF))

2054

(if (or (eql term2 +INF) (eql term2 -INF))

2055

(if (eql term1 term2)

2056

term1

2057

NAN)

2058

(if (zerop term2)

2059

NAN

2060

(* term1 term2)))

2061

(if (or (eql term2 +INF) (eql term2 -INF))

2062

(if (zerop term1) NAN term2)

2063

(* term1 term2)))))

2064

;; casting

2065

(:method ((object t) (term2 t))

2066

(spocq.e:|*| (spocq.e::number object) term2))

2067

(:method ((term1 number) (object t))

2068

(spocq.e:|*| term1 (spocq.e::number object))))

2069

2070

2071

(defmacro spocq.a:|/| (expression-1 expression-2)

2072

"( ( numeric numeric ) numeric )"

2073

(setf (variable-opacity (expression-variables expression-1)) :transparent)

2074

(setf (variable-opacity (expression-variables expression-2)) :transparent)

2075

`(spocq.e:|/| ,expression-1 ,expression-2))

2076

2077

(defgeneric spocq.e:|/| (term1 term2)

2078

(:method ((term1 number) (term2 number))

2079

(if (or (eql term1 NAN) (eql term2 NAN))

2080

NAN

2081

(if (zerop term2)

2082

(error 'division-by-zero :operation ' spocq.a:|/| :operands (list term1 term2))

2083

(/ term1 term2))))

2084

(:method ((term1 float) (term2 float))

2085

(if (or (eql term1 NAN) (eql term2 NAN))

2086

NAN

2087

(if (and (or (eql term1 +INF) (eql term1 -INF))

2088

(or (eql term2 +INF) (eql term2 -INF)))

2089

NAN

2090

(if (zerop term2)

2091

(if (zerop term1)

2092

NAN

2093

(cond ((plusp term1) +INF)

2094

((minusp term1) -INF)

2095

(t NAN)))

2096

(/ term1 term2)))))

2097

;; casting

2098

(:method ((object t) (term2 t))

2099

(spocq.e:|/| (spocq.e::number object) term2))

2100

(:method ((term1 number) (object t))

2101

(spocq.e:|/| term1 (spocq.e::number object))))

2102

2103

2104

;;; regular expressions

2105

;;;

2106

;;; there are three documents which relate to sparql regular expressions

2107

;;; the sparql [spec](http://www.w3.org/TR/rdf-sparql-query/#restrictString),

2108

;;; its reference to the xquery/xpath [spec](http://www.w3.org/TR/xpath-functions/#regex-syntax),

2109

;;; and the xml schema [spec](http://www.w3.org/TR/xmlschema-2/#regexs).

2110

;;; the last distinguishes its expressions as wil implicit start/end anchors.

2111

;;; the second describes some functions as requiring explicit anchors

2112

;;; the sparql spec has some examples which succeed only of the anchors must be explicit.

2113

;;; that's what this implementation assumes.

2114

;;; the second spec ahs _numerous_ stipulations, time will tell if cl-ppcre is sufficient.

2115

2116

#+(or)

2117

(defmacro spocq.a:|regex| (text pattern &optional (flags nil))

2118

"( ( stringLiteral simpleLiteral simpleLiteral? ) xsd:boolean )

2119

The REGEX function invokes the XPath fn:matches function to match text against

2120

a regular expression pattern. The regular expression language is defined in

2121

XQuery 1.0 and XPath 2.0 Functions and Operators section 7.6.1

2122

Regular Expression Syntax.

2123

2124

If the pattern is a constant, precompile it."

2125

2126

(typecase flags

2127

(null )

2128

(string (setf flags (equal flags "i")))

2129

(t

2130

(setf (variable-opacity (expression-variables flags)) :transparent)

2131

(setf flags `(equal ,flags "i"))))

2132

(cond ((and (stringp pattern) (typep flags 'boolean))

2133

`(spocq.e:regex ,text ,(cl-ppcre:create-scanner pattern :case-insensitive-mode flags)))

2134

(t

2135

(setf (variable-opacity (expression-variables pattern)) :transparent)

2136

`(spocq.e:regex ,text (cl-ppcre:create-scanner ,pattern :case-insensitive-mode ,flags)))))

2137

2138

2139

(defmacro spocq.a:|regex| (string pattern &optional (insensitive nil) &environment env)

2140

"Generate a regex call based on the given pattern and insensitive expressions.

2141

If the pattern is a constant, preprocess it."

2142

2143

(macroexpand-regex string pattern insensitive env))

2144

2145

(defun macroexpand-regex (string pattern insensitive env)

2146

(typecase insensitive

2147

(null )

2148

(string (setf insensitive (equal insensitive "i")))

2149

(t

2150

(setf (variable-opacity (expression-variables insensitive)) :transparent)

2151

(setf insensitive `(equal ,insensitive "i"))))

2152

(cond ((and (stringp pattern) (typep insensitive 'boolean))

2153

(let* ((scanner (cl-ppcre:create-scanner pattern :case-insensitive-mode insensitive))

2154

(string-expansion (macroexpand-1 string env))

2155

(string-term-expression (cond ((field-object-aref-p string-expansion)

2156

                                                `(aref ,@(field-object-aref-aref string-expansion)))

2157

                                               ((term-number-object-p string-expansion)

2158

                                                (second string-expansion)))))

2159

(if string-term-expression

2160

`(spocq.e:regex (get-term-number-string ,string-term-expression) ,scanner)

2161

`(spocq.e:regex ,string ,scanner))))

2162

(t

2163

(setf (variable-opacity (expression-variables pattern)) :transparent)

2164

#+(or) ;; this reused a scanner per site, but it needs to be per pattern

2165

(let* ((key (gensym "regex-scanner-")))

2166

`(let ((scanner (or (get-aspect-cache ',key)

2167

(setf (get-aspect-cache ',key)

2168

                                      (cl-ppcre:create-scanner ,pattern :case-insensitive-mode ,insensitive)))))

2169

(spocq.e:regex ,string scanner)))

2170

`(let* ((key (concatenate 'string "regex-scanner-" ,pattern))

2171

(scanner (or (get-aspect-cache key)

2172

(setf (get-aspect-cache key)

2173

                                     (cl-ppcre:create-scanner ,pattern :case-insensitive-mode ,insensitive)))))

2174

(spocq.e:regex ,string scanner)))))

2175

2176

2177

(defun get-term-number-string (term-number)

2178

(let ((term-value (term-number-object term-number)))

2179

(typecase term-value

2180

(string term-value)

2181

(spocq:plain-literal (spocq:literal-lexical-form term-value))

2182

(t (spocq.e:argument-type-error :operator 'get-term-number-string :expected-type 'string

2183

                                       :datum (list term-number term-value))))))

2184

2185

2186

;;; for tracing

2187

(defun call-scanner (scanner term start length)

2188

(funcall scanner term start length))

2189

2190

(defgeneric spocq.e:regex (term pattern &optional start length)

2191

(:documentation "match a simple string literal to a pattern. if the argument is

2192

typed ot language tagged, or anyhing other than a string, return nil.")

2193

2194

(:method ((term t) (pattern t) &optional start length)

2195

"If the term is not a string, just return nil.

2196

In a filter context, the effect is the same as signalling an error"

2197

(declare (ignore start length))

2198

nil)

2199

2200

(:method ((term string) (pattern string) &optional (start 0) (length (length term)))

2201

(spocq.e:regex term (cl-ppcre:create-scanner pattern) start length))

2202

2203

(:method ((term string) (scanner function) &optional (start 0) (length (length term)))

2204

(unless (simple-string-p term) ; from cl-ppcre:scan

2205

(setf term (coerce term 'simple-string)))

2206

(when (funcall scanner term start length) t))

2207

2208

(:method ((term spocq:string) (scanner t) &optional (start 0) length)

2209

(let ((string (spocq:literal-lexical-form term)))

2210

(spocq.e:regex string scanner start (or length (length string)))))

2211

2212

(:method ((term spocq:plain-literal) (scanner t) &optional (start 0) length)

2213

(let ((string (spocq:literal-lexical-form term)))

2214

(when string

2215

(spocq.e:regex string scanner start length)))))

2216

2217

(defun compile-regex-replacement (pattern replacement &key case-insensitive-mode)

2218

(labels ((regex-contains-register-p (object)

2219

(typecase object

2220

(symbol (eq object :register))

2221

(list (some #'regex-contains-register-p object))

2222

(t nil))))

2223

(let ((parsed-pattern (etypecase pattern (string (cl-ppcre:parse-string pattern)) (cons pattern)))

2224

(replacement-scanner (load-time-value (cl-ppcre:create-scanner "\\$([0-9]?)"))))

2225

(when (regex-contains-register-p parsed-pattern)

2226

(setf replacement (cl-ppcre:regex-replace-all replacement-scanner replacement "\\\\{\\{1}}")))

2227

(log-trace "compile-regex-replacement: ~s ~s" parsed-pattern replacement)

2228

       (values (cl-ppcre:create-scanner parsed-pattern :case-insensitive-mode case-insensitive-mode) replacement))))

2229

2230

(defmacro spocq.a:|replace| (arg pattern replacement &optional (flags nil))

2231

"( ( stringLiteral simpleLiteral simpleLiteral simpleLiteral? ) stringLiteral )

2232

The REPLACE function corresponds to the XPath fn:replace function.

2233

It replaces each non-overlapping occurrence of the regular expression pattern

2234

with the replacement string. Regular expession matching may involve modifier

2235

flags. See REGEX.

2236

2237

If the pattern is a constant, preprocess it."

2238

2239

(typecase flags

2240

(null )

2241

(string (setf flags (equal flags "i")))

2242

(t

2243

(setf (variable-opacity (expression-variables flags)) :transparent)

2244

(setf flags `(equal ,flags "i"))))

2245

(cond ((and (stringp pattern) (typep flags 'boolean))

2246

(multiple-value-bind (scanner replacement)

2247

                               (compile-regex-replacement pattern replacement :case-insensitive-mode flags)

2248

`(spocq.e:replace ,arg ,scanner ,replacement)))

2249

(t

2250

(setf (variable-opacity (expression-variables pattern)) :transparent)

2251

`(multiple-value-bind (scanner replacement)

2252

                                (compile-regex-replacement ,pattern ,replacement :case-insensitive-mode ,flags)

2253

(spocq.e:replace ,arg scanner replacement)))))

2254

2255

2256

(defgeneric spocq.e:replace (term pattern replacement)

2257

   (:documentation "match a simple string literal to a pattern and replace all non-overlapping matched with the

2258

  replacement string. if the argument is typed ot language tagged, or anyhing other than a string, return nil.")

2259

2260

(:method ((term t) (pattern t) (replacement t))

2261

(spocq.e:argument-type-error :datum (list term pattern replacement)

2262

:operator 'spocq.a:|replace|

2263

:expected-type |xsd|:|boolean|))

2264

2265

(:method ((term spocq:string) (pattern t) (replacement t))

2266

(spocq.e:replace (spocq:literal-lexical-form term) pattern replacement))

2267

2268

(:method ((term spocq:plain-literal) (pattern t) (replacement t))

2269

(intern-term-aspects :literal (spocq.e:replace (spocq:literal-lexical-form term) pattern replacement)

2270

nil (spocq:plain-literal-language-tag term)))

2271

2272

(:method ((term t) (pattern spocq:string) (replacement t))

2273

(spocq.e:replace term (spocq:literal-lexical-form pattern) replacement))

2274

2275

(:method ((term t) (pattern t) (replacement spocq:string))

2276

(spocq.e:replace term pattern (spocq:literal-lexical-form replacement)))

2277

2278

(:method ((term string) (pattern string) (replacement string))

2279

(multiple-value-bind (scanner replacement)

2280

                          (compile-regex-replacement pattern replacement :case-insensitive-mode nil)

2281

(spocq.e:replace term scanner replacement)))

2282

2283

(:method ((term string) (scanner function) (replacement string))

2284

(unless (simple-string-p term) ; from cl-ppcre:scan

2285

(setf term (coerce term 'simple-string)))

2286

(cl-ppcre:regex-replace-all scanner term replacement))

2287

2288

#+(or) ;; use cl-ppcre utility operator to handle register substitutions

2289

(:method ((term string) (scanner function) (replacement string) &key &allow-other-keys)

2290

(unless (simple-string-p term) ; from cl-ppcre:scan

2291

(setf term (coerce term 'simple-string)))

2292

(let ((substrings ())

2293

(start 0)

2294

(end (length term)))

2295

(loop (multiple-value-bind (match-start match-end)

2296

(funcall scanner term start end)

2297

(cond (match-start

2298

(push (subseq term start match-start) substrings)

2299

(push replacement substrings)

2300

(setf start match-end))

2301

(substrings

2302

(return (apply #'concatenate 'string

2303

                                      (nreverse (cons (subseq term start) substrings)))))

2304

(t

2305

(return term))))))))

2306

2307

;;; sequence uri

2308

2309

(defmacro |http://www.w3.org/1999/02/22-rdf-syntax-ns#|:|Seq| (&optional type)

2310

(case type

2311

(|xsd|:|integer| `(spocq.e::sequence-number))

2312

(t `(spocq.e:sequence-uri))))

2313

2314

(defun spocq.e:sequence-uri ()

2315

(cons-sequence-uri))

2316

2317

(defun spocq.e::sequence-number ()

2318

(cons-sequence-number))

2319

2320

2321

2322

;;; casting functions

2323

;;;

2324

;;; implement the constructor function [matrix](http://www.w3.org/TR/rdf-sparql-query/#FunctionMapping)

2325

;;; with the addition of {xsd}date

2326

2327

(defmacro |xsd|:|string| (expression)

2328

"( ( RDFTerm ) xsd:string )"

2329

(setf (variable-opacity (expression-variables expression)) :transparent)

2330

`(spocq.e:string ,expression))

2331

2332

(defgeneric spocq.e:string (object)

2333

(:documentation "Generate the string representation for the literal. cf spocq:|str|")

2334

2335

(:method ((object spocq:unbound-variable))

2336

;;object)

2337

;; should error due to possible role in aggregations

2338

(spocq.e:argument-type-error :operator 'spocq.a:|str|

2339

:expected-type '|xsd|:|string|

2340

:datum object))

2341

2342

(:method ((object spocq:blank-node))

2343

(spocq:blank-node-label object))

2344

(:method ((object spocq:boolean))

2345

(if (equal object spocq.a:|true|) "true" "false"))

2346

(:method ((object spocq:string))

2347

(spocq:literal-lexical-form object))

2348

(:method ((object spocq:iri))

2349

(spocq:iri-lexical-form object))

2350

(:method ((object spocq:number))

2351

(spocq.e:string (literal-value object)))

2352

(:method ((object string))

2353

object)

2354

2355

(:method ((object ratio))

2356

(if (zerop (numerator object))

2357

"0.0"

2358

(format nil "~f" object)))

2359

(:method ((object single-float))

2360

(let ((*read-default-float-format* 'single-float))

2361

(format nil "~f" object)))

2362

(:method ((object double-float))

2363

(let ((*read-default-float-format* 'double-float))

2364

(format nil "~f" object)))

2365

(:method ((object ratio))

2366

(format nil "~f" object))

2367

(:method ((object number))

2368

(princ-to-string object))

2369

(:method ((object spocq:temporal))

2370

(term-lexical-form object))

2371

(:method ((object symbol))

2372

(symbol-uri-namestring object))

2373

(:method ((object spocq:literal))

2374

(spocq:literal-lexical-form object)))

2375

2376

2377

(defmacro |xsd|:|float| (expression)

2378

"( ( (or xsd:boolean xsd:string numeric) ) xsd:float )"

2379

(setf (variable-opacity (expression-variables expression)) :transparent)

2380

`(spocq.e:float ,expression))

2381

2382

(defgeneric spocq.e:float (object)

2383

2384

(:method ((object spocq:unbound-variable))

2385

;;object)

2386

;; should error due to possible role in aggregations

2387

(spocq.e:argument-type-error :operator '|xsd|:|float|

2388

:expected-type '|xsd|:|float|

2389

:datum object))

2390

2391

(:method ((object spocq:boolean))

2392

(if (equal object spocq.a:|true|) 1.0s0 0.0s0))

2393

(:method ((object spocq:float))

2394

(literal-value object))

2395

(:method ((object spocq:number))

2396

(float (literal-value object) 0.0s0))

2397

(:method ((object string))

2398

(let ((*read-default-float-format* 'single-float))

2399

(cond ((multiple-value-bind (value next)

2400

(meta:parse-float object)

2401

(when (= next (length object)) value)))

2402

((string-equal object "nan")

2403

DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-NAN)

2404

((string-equal object "inf")

2405

DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-POSITIVE-INFINITY)

2406

((string-equal object "-inf")

2407

DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-NEGATIVE-INFINITY)

2408

(t

2409

(invalid-argument-type {xsd}float object double-float)))))

2410

(:method ((object single-float))

2411

object)

2412

(:method ((object rational))

2413

(if (eql (denominator object) 1)

2414

(float (numerator object) 0.0s0)

2415

(float object 0.0s0)))

2416

(:method ((object number))

2417

(float object 0.0s0))

2418

(:method ((object t))

2419

(invalid-argument-type |xsd|:|float| object single-float)))

2420

2421

(defmethod xsd-lexical-representation ((object single-float))

2422

(cond ((eql object DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-NAN)

2423

"NaN")

2424

((eql object DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-POSITIVE-INFINITY)

2425

"INF")

2426

((eql object DE.SETF.UTILITY.CODECS:SINGLE-FLOAT-NEGATIVE-INFINITY)

2427

"-INF")

2428

(t

2429

(princ-to-string object))))

2430

2431

2432

(defmacro |xsd|:|double| (expression)

2433

"( ( (or xsd:boolean xsd:string numeric) ) xsd:double )"

2434

(setf (variable-opacity (expression-variables expression)) :transparent)

2435

`(spocq.e:double ,expression))

2436

2437

(defgeneric spocq.e:double (object)

2438

(:method ((object spocq:unbound-variable))

2439

;;object)

2440

;; should error due to possible role in aggregations

2441

(spocq.e:argument-type-error :operator '|xsd|:|double|

2442

:expected-type '|xsd|:|double|

2443

:datum object))

2444

2445

(:method ((object spocq:boolean))

2446

(if (equal object spocq.a:|true|) 1.0d0 0.0d0))

2447

(:method ((object spocq:double))

2448

(literal-value object))

2449

(:method ((object spocq:number))

2450

(float (literal-value object) 0.0d0))

2451

(:method ((object string))

2452

(let ((*read-default-float-format* 'double-float))

2453

(cond ((multiple-value-bind (value next)

2454

(meta:parse-float object)

2455

(and (= next (length object)) value)))

2456

((string-equal object "nan")

2457

DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-NAN)

2458

((string-equal object "inf")

2459

DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-POSITIVE-INFINITY)

2460

((string-equal object "-inf")

2461

DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-NEGATIVE-INFINITY)

2462

(t

2463

(invalid-argument-type {xsd}float object double-float)))))

2464

(:method ((object double-float))

2465

object)

2466

(:method ((object rational))

2467

(if (eql (denominator object) 1)

2468

(float (numerator object) 0.0d0)

2469

(float object 0.0d0)))

2470

(:method ((object number))

2471

(float object 0.0d0))

2472

(:method ((object t))

2473

(invalid-argument-type |xsd|:|double| object double-float)))

2474

2475

(defmethod xsd-lexical-representation ((object double-float))

2476

(cond ((eql object DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-NAN)

2477

"NaN")

2478

((eql object DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-POSITIVE-INFINITY)

2479

"INF")

2480

((eql object DE.SETF.UTILITY.CODECS:DOUBLE-FLOAT-NEGATIVE-INFINITY)

2481

"-INF")

2482

(t

2483

(princ-to-string object))))

2484

2485

2486

(defmacro |xsd|:|decimal| (expression)

2487

"( ( (or xsd:boolean xsd:string numeric) ) xsd:decimal )"

2488

(setf (variable-opacity (expression-variables expression)) :transparent)

2489

`(spocq.e:decimal ,expression))

2490

2491

(defgeneric spocq.e:decimal (object)

2492

(:method ((object spocq:unbound-variable))

2493

;;object)

2494

;; should error due to possible role in aggregations

2495

(spocq.e:argument-type-error :operator '|xsd|:|decimal|

2496

:expected-type '|xsd|:|decimal|

2497

:datum object))

2498

2499

(:method ((object spocq:boolean))

2500

(spocq.e:decimal (if (equal object spocq.a:|true|) 1 0)))

2501

(:method ((object spocq:integer))

2502

(spocq.e:decimal (literal-value object)))

2503

(:method ((object spocq:number))

2504

(spocq.e:decimal (literal-value object)))

2505

(:method ((object string))

2506

(cond ((is-integer-string object)

2507

(spocq.e:decimal (parse-integer object :junk-allowed nil)))

2508

((is-decimal-string object)

2509

(let ((*read-default-float-format* 'single-float))

2510

(or (multiple-value-bind (value next)

2511

(meta:parse-float object)

2512

(and (= next (length object)) (spocq.e:decimal value)))

2513

(invalid-argument-type |xsd|:|decimal| object double-float))))

2514

(t

2515

(call-next-method))))

2516

(:method ((object ratio))

2517

object)

2518

(:method ((object integer))

2519

#+sbcl (sb-kernel::%make-ratio object 1)

2520

#-sbcl object)

2521

(:method ((object number))

2522

(let ((rationalized (rationalize object)))

2523

(typecase rationalized

2524

(integer (spocq.e:decimal rationalized))

2525

(t rationalized))))

2526

(:method ((object t))

2527

(invalid-argument-type |xsd|:|decimal| object ratio)))

2528

2529

#+(or)

2530

(progn (defun test-make-rational (num den) (sb-kernel::%make-ratio num den))

2531

(loop for num from 1 below 10

2532

do (loop for den from 1 to 10

2533

for via-rational = (ceiling (test-make-rational num den))

2534

for via-float-rational = (ceiling (float (test-make-rational num den)))

2535

for via-float = (ceiling (float (/ num den)))

2536

;; unless (= via-rational via-float-rational via-float)

2537

do (print (list num den :via-rational via-rational :via-float-rational via-float-rational

2538

:via-float via-float)))))

2539

2540

2541

2542

(defmacro |xsd|:|integer| (expression)

2543

"( ( (or xsd:boolean xsd:string numeric) ) xsd:integer )"

2544

(setf (variable-opacity (expression-variables expression)) :transparent)

2545

`(spocq.e:integer ,expression))

2546

2547

(defgeneric spocq.e:integer (object)

2548

2549

(:method ((object spocq:unbound-variable))

2550

object)

2551

2552

(:method ((object spocq:boolean))

2553

(if (equal object spocq.a:|true|) 1 0))

2554

(:method ((object spocq:integer))

2555

(literal-value object))

2556

(:method ((object spocq:number))

2557

(round (literal-value object)))

2558

(:method ((object string))

2559

(parse-integer object :junk-allowed nil))

2560

(:method ((object integer))

2561

object)

2562

(:method ((object number))

2563

(round object))

2564

(:method ((object t))

2565

(invalid-argument-type |xsd|:|integer| object integer)))

2566

2567

2568

(defmacro |xsd|:|boolean| (expression)

2569

"( ( (or xsd:boolean xsd:string numeric) ) xsd:boolean )"

2570

(setf (variable-opacity (expression-variables expression)) :transparent)

2571

`(spocq.e:boolean ,expression))

2572

2573

(defgeneric spocq.e:boolean (object)

2574

2575

(:method ((object spocq:unbound-variable))

2576

object)

2577

2578

(:method ((object spocq:boolean))

2579

object)

2580

(:method ((object spocq:number))

2581

(not (zerop (literal-value object))))

2582

(:method ((object string))

2583

(cond ((or (equal object "true") (equal object "1")) spocq.a:|true|)

2584

((or (equal object "false") (equal object "0")) spocq.a:|false|)

2585

(t

2586

(invalid-argument-type |xsd|:|boolean| object |xsd|:|boolean|))))

2587

(:method ((object number))

2588

(if (or (zerop object) (eql object NAN) (eql object dsu.codecs:double-float-nan))

2589

spocq.a:|false| spocq.a:|true|))

2590

(:method ((object t))

2591

(invalid-argument-type |xsd|:|boolean| object |xsd|:|boolean|)))

2592

2593

2594

;;;

2595

;;; argument type error interprtation and signaling

2596

2597

(defgeneric predicate-argument-type-error (operator term1 term2 &optional combined-type)

2598

(:documentation "Given TERM1 and TERM2, which failed to met the restrictions for the OPERATOR,

2599

determine which was mistyped and signal a type error.")

2600

2601

(:method (operator term1 term2 &optional combined-type)

2602

(spocq.e:argument-type-error :operator operator :expected-type combined-type

2603

:datum (list operator term1 term2)))

2604

2605

(:method (operator (term1 number) (term2 t) &optional (type (spocq.a:|datatype| term1)))

2606

(spocq.e:argument-type-error :operator operator :expected-type type :datum term2))

2607

(:method (operator (term1 t) (term2 number) &optional (type (spocq.a:|datatype| term1)))

2608

(predicate-argument-type-error operator term2 term1 type))

2609

2610

(:method (operator (term1 string) (term2 t) &optional (type (spocq.a:|datatype| term1)))

2611

(spocq.e:argument-type-error :operator operator :expected-type type :datum term2))

2612

(:method (operator (term1 t) (term2 string) &optional (type (spocq.a:|datatype| term1)))

2613

(predicate-argument-type-error operator term2 term1 type))

2614

2615

(:method (operator (term1 symbol) (term2 t) &optional (type (spocq.a:|datatype| term1)))

2616

(spocq.e:argument-type-error :operator operator :expected-type type :datum term2))

2617

(:method (operator (term1 t) (term2 symbol) &optional (type (spocq.a:|datatype| term1)))

2618

(predicate-argument-type-error operator term2 term1 type))

2619

2620

)

2621

2622

2623

;;; tests

2624

2625

(unless (null (remove t (mapcar #'(lambda (v1 v2) (or (equalp v1 v2) (list v1 v2)))

2626

(let ((terms (list (spocq:make-unsupported-typed-literal "one" <http://example.org/unknown-one>)

2627

(spocq:make-unsupported-typed-literal "two" <http://example.org/unknown-one>)

2628

(spocq:make-unsupported-typed-literal "one" <http://example.org/unknown-two>)

2629

<http://example.org/one>

2630

(cons-blank-node "one")

2631

10000

2632

"one")))

2633

(flet ((summary (term)

2634

(typecase term

2635

(spocq:unsupported-typed-literal (cons (spocq:literal-lexical-form term)

2636

                                                     (spocq:unsupported-typed-literal-datatype-uri term)))

2637

(t (type-of term)))))

2638

(loop for term1 in terms

2639

append (loop for term2 in terms

2640

collect (list (summary term1) (summary term2)

2641

                            (handler-case (spocq.e:= term1 term2) (error () :n/a)))))))

2642

'((("one" . <http://example.org/unknown-one>) ("one" . <http://example.org/unknown-one>) T)

2643

(("one" . <http://example.org/unknown-one>) ("two" . <http://example.org/unknown-one>) :N/A)

2644

(("one" . <http://example.org/unknown-one>) ("one" . <http://example.org/unknown-two>) :n/a)

2645

(("one" . <http://example.org/unknown-one>) SPOCQ:HTTP-URL NIL)

2646

(("one" . <http://example.org/unknown-one>) SPOCQ:BLANK-NODE NIL)

2647

(("one" . <http://example.org/unknown-one>) (INTEGER 0 4611686018427387903) :N/A)

2648

(("one" . <http://example.org/unknown-one>) (SIMPLE-ARRAY CHARACTER (3)) :N/A)

2649

(("two" . <http://example.org/unknown-one>) ("one" . <http://example.org/unknown-one>) :N/A)

2650

(("two" . <http://example.org/unknown-one>) ("two" . <http://example.org/unknown-one>) T)

2651

(("two" . <http://example.org/unknown-one>) ("one" . <http://example.org/unknown-two>) :n/a)

2652

(("two" . <http://example.org/unknown-one>) SPOCQ:HTTP-URL NIL)

2653

(("two" . <http://example.org/unknown-one>) SPOCQ:BLANK-NODE NIL)

2654

(("two" . <http://example.org/unknown-one>) (INTEGER 0 4611686018427387903) :N/A)

2655

(("two" . <http://example.org/unknown-one>) (SIMPLE-ARRAY CHARACTER (3)) :N/A)

2656

(("one" . <http://example.org/unknown-two>) ("one" . <http://example.org/unknown-one>) :n/a)

2657

(("one" . <http://example.org/unknown-two>) ("two" . <http://example.org/unknown-one>) :n/a)

2658

(("one" . <http://example.org/unknown-two>) ("one" . <http://example.org/unknown-two>) T)

2659

(("one" . <http://example.org/unknown-two>) SPOCQ:HTTP-URL NIL)

2660

(("one" . <http://example.org/unknown-two>) SPOCQ:BLANK-NODE NIL)

2661

(("one" . <http://example.org/unknown-two>) (INTEGER 0 4611686018427387903) :N/A)

2662

(("one" . <http://example.org/unknown-two>) (SIMPLE-ARRAY CHARACTER (3)) :N/A)

2663

(SPOCQ:HTTP-URL ("one" . <http://example.org/unknown-one>) NIL)

2664

(SPOCQ:HTTP-URL ("two" . <http://example.org/unknown-one>) NIL)

2665

(SPOCQ:HTTP-URL ("one" . <http://example.org/unknown-two>) NIL)

2666

(SPOCQ:HTTP-URL SPOCQ:HTTP-URL T)

2667

(SPOCQ:HTTP-URL SPOCQ:BLANK-NODE NIL)

2668

(SPOCQ:HTTP-URL (INTEGER 0 4611686018427387903) NIL)

2669

(SPOCQ:HTTP-URL (SIMPLE-ARRAY CHARACTER (3)) NIL)

2670

(SPOCQ:BLANK-NODE ("one" . <http://example.org/unknown-one>) NIL)

2671

(SPOCQ:BLANK-NODE ("two" . <http://example.org/unknown-one>) NIL)

2672

(SPOCQ:BLANK-NODE ("one" . <http://example.org/unknown-two>) NIL)

2673

(SPOCQ:BLANK-NODE SPOCQ:HTTP-URL NIL)

2674

(SPOCQ:BLANK-NODE SPOCQ:BLANK-NODE T)

2675

(SPOCQ:BLANK-NODE (INTEGER 0 4611686018427387903) NIL)

2676

(SPOCQ:BLANK-NODE (SIMPLE-ARRAY CHARACTER (3)) NIL)

2677

((INTEGER 0 4611686018427387903) ("one" . <http://example.org/unknown-one>) :N/A)

2678

((INTEGER 0 4611686018427387903) ("two" . <http://example.org/unknown-one>) :N/A)

2679

((INTEGER 0 4611686018427387903) ("one" . <http://example.org/unknown-two>) :N/A)

2680

((INTEGER 0 4611686018427387903) SPOCQ:HTTP-URL NIL)

2681

((INTEGER 0 4611686018427387903) SPOCQ:BLANK-NODE NIL)

2682

((INTEGER 0 4611686018427387903) (INTEGER 0 4611686018427387903) T)

2683

((INTEGER 0 4611686018427387903) (SIMPLE-ARRAY CHARACTER (3)) NIL)

2684

((SIMPLE-ARRAY CHARACTER (3)) ("one" . <http://example.org/unknown-one>) :N/A)

2685

((SIMPLE-ARRAY CHARACTER (3)) ("two" . <http://example.org/unknown-one>) :N/A)

2686

((SIMPLE-ARRAY CHARACTER (3)) ("one" . <http://example.org/unknown-two>) :N/A)

2687

((SIMPLE-ARRAY CHARACTER (3)) SPOCQ:HTTP-URL NIL)

2688

((SIMPLE-ARRAY CHARACTER (3)) SPOCQ:BLANK-NODE NIL)

2689

((SIMPLE-ARRAY CHARACTER (3)) (INTEGER 0 4611686018427387903) NIL)

2690

((SIMPLE-ARRAY CHARACTER (3)) (SIMPLE-ARRAY CHARACTER (3)) T) ))))

2691

(warn "spocq.e:= validation failed"))

2692

2693

#|

2694

;;; temporal-proximity-by-exclusion-nex-1

2695

2696

(setq *algebra-trace-output* (setq *data-trace-output* *trace-output*))

2697

(setq *bgp-trace-output* *trace-output*)

2698

2699

(run-test-query "

2700

PREFIX ex: <http://www.w3.org/2009/sparql/docs/tests/data-sparql11/negation#>

2701

PREFIX dc: <http://purl.org/dc/elements/1.1/>

2702

2703

# The closest pre-operative physical examination

2704

SELECT ?exam ?date {

2705

?exam a ex:PhysicalExamination;

2706

dc:date ?date;

2707

ex:precedes ex:operation1 .

2708

?op a ex:SurgicalProcedure; dc:date ?opDT .

2709

FILTER NOT EXISTS {

2710

?otherExam a ex:PhysicalExamination;

2711

ex:follows ?exam;

2712

ex:precedes ex:operation1

2713

}

2714

}

2715

"

2716

                 :repository-id (lookup-repository-id :repository-name "negation-temporal-proximity-by-exclusion-nex-1" :account-name "jhacker"))

2717

2718

|#

2719

�