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

KindCoveredAll%
expression0645 0.0
branch058 0.0
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 implements inverted SPARQL matching."
6
 
7
  (copyright
8
   "Copyright 2019 [datagraph gmbh](mailto:james@datagraph.org) All Rights Reserved.")
9
 
10
  (long-description
11
   "This follows from Forgy's work on indexing rules for production systems in ops5:
12
 
13
 The original work applied to rule preconditions, which are equivalent to SPARQL BGPs.
14
 This implementation generalizes that to that subset of SPARQL which covers
15
 - binding : bgp, bind, values
16
 - combination : join, optional, union
17
 - selection : filter
18
 - projection : ask, construct, select
19
 It does not include either qualifiers or aggregation.
20
 
21
 In order to interpret a SPARQL query, the symbolic SPARQL expression tree
22
 is used to control the interpretation of successive quad statements to yield
23
 solutions. Each statement's effects - that is, the intermediate solutions
24
 which it produces for each algebra node, is recorded in an autonomous state.
25
 As successive statements are introduced, their effects percolate upwards
26
 through the operation tree until the SPARQL graph accepts a statement by
27
 emitts the solutions which the statementto that point have matched.
28
 
29
 The interpretation proceeds in phases
30
 - the input query is either an sse in terms of spocq.a operators or a query
31
   text, which is parsed to produce the sse.
32
 - a macroexpansion phase substitutes isparql operators for supported spocq.a
33
   operators
34
 - the isparql expressions are evaluated within a transaction to yield another
35
   spocq.a sse, but one which with interned which is arranged to be interpreted,
36
   rather 
37
 - the interned sparql expression combines with a statement an on-going state
38
   and a continuation to yield matching solutions to the continuation
39
 
40
 the supported SPARQL operators are:
41
 - ask : the first solution generate true. otherwise completion yields false
42
 - bgp : handled as a multi-join of quad patterns
43
 - construct : each solution yields a triple sequence
44
 - join : incident statements collect solutions from each branch, check each
45
   new result against the other respective solutions and yield compatible pairs
46
   as merged solutions.
47
 - quad :  quad patterns, each statement which unifies yields a new solution.
48
   this may be empty for matched constants
49
 - bind : extends solutions with a binding
50
 - values : introduces a solution field
51
 - filter : continues iff the filter predicate is satisfied
52
 
53
 Statement processing combines each statement with the activation tree and an
54
 interpretation state, which arranges intermediate solutions per node.
55
 Cached solutions could hold a timestamp in addition to the bindings to permit
56
 olders solutions to expire.
57
 
58
 The interface comprises two operators
59
 - compute-isparql-processor :
60
   accepts the expression and optionally a continuation and a state.
61
   returns a function which accepts statements, optionally continuation and
62
   state values to override those from construction, and yields solutions to the
63
   continuation
64
 - run-isparql :
65
   accepts the expression, a source and a continuation
66
   iterates over statements from the source and yields solutions to the
67
   continuation
68
 
69
 
70
 This mechanism serves as indices for entailment and update rules.
71
 In both cases the index keys are one or more statement patterns and the values
72
 are rule identifiers.
73
 The entailment rules define patterns to extend the source BGP or arbitrary
74
 sub-queries to integrate into the control-flow.
75
 Update rules identify actions to perform when a change is made, to either
76
 reject the change or augment it.
77
 
78
 Rule declarations are stored in a repository in one of three forms:
79
 - simple SPARQL construct queries, stored as strings
80
 - SPIN definitions, from which the respective SPARQL operations is extracted
81
 - SHACL declarations (NYI)
82
 
83
 The index logic performs matching by unification, rather than just statement
84
 pattern combination, because variables may appear on either side in order that
85
 rules can be expressed abstractly, rather than exhaustively. This requires that
86
 respective constants and variables in statements and query patterns match in
87
 either direction.
88
 
89
  - - -
90
  c.forgy's original :
91
    C. Forgy. Rete: A fast algorithm for the many patterns/many objects match problem. Artif. Intel l., 19(1):17-37, 1982.
92
  doorenbos integration into production systems
93
    R. Doorenbos. Production Matching for Large Learning Systems. CMU-CS-95-113
94
  applications to cep :
95
    Y. Shvartzshnaider, etal. Future Internet - FIS 2010 - Third Future Internet Symposium, Berlin, Germany, September 20-22, 2010. Proceedings (3870_publication_Publish_Su_3236.pdf)
96
      discusses dht and rete for pub/sub
97
    Mapping Rete algorithm to FOL and then to RDF/N3 - Copia's posterous.webloc : rdf matching in python ()
98
     diagram(http://cvs.4suite.org/viewcvs/*checkout*/Fuxi/fuxi.png)
99
    K. Walzer, etal. Relative Temporal Constraints in the Rete Algorithm for Complex Event Detection. DEBS 08, July 1-4, 2008, Rome, Italy")
100
  )
101
 
102
 ;;; (with-compilation-unit  () (load "patches/isparql.lisp"))
103
 (defpackage :isparql
104
   (:use )
105
   (:import-from :spocq.i
106
                 spocq.i::state-node-states)
107
   (:export "ask"
108
            "bgp"
109
            "construct"
110
            "extend"
111
            "filter"
112
            "graph"
113
            "join"
114
            "leftjoin"
115
            "quad"
116
            "bindings"
117
            "select"
118
            "table"
119
            "triple"
120
            "union"
121
            :isparql
122
            :isparql-op
123
            :state
124
            :node-state
125
            :solution-products
126
            :state-node-state
127
            :state-node-states
128
            :unify-statements
129
            :unify-terms
130
            :node-state))
131
 
132
 
133
 ;;; use the macroprocessor to rewrite sse expressions onto self-constructing forms
134
 ;;; delay term interning until the form is executed
135
 ;;; rearrange especially the bgp interpretation
136
 ;;;
137
 ;;; the intern phase culd be delayed for all forms until the first
138
 ;;;  interpretation call for the respective node
139
 
140
 (defun macroexpand-isparql (expander form &optional env)
141
   (let* ((op (first form))
142
          (isparql-op (and (eq (symbol-package op) (find-package :spocq.a))
143
                          (find-symbol (string op) :isparql))))
144
     (if isparql-op
145
         (values (cons isparql-op (rest form)))
146
         (funcall expander form env))))
147
 
148
 (defmacro isparql:|ask| (solution-field)
149
   `(list 'spocq.a:|ask| ',solution-field))
150
 
151
 (defmacro isparql:|bgp| (&rest statement-patterns)
152
   "Deconstruct a spocq:|bgp| form which contains quads which include the graph.
153
    Yield nested joins to combine the quads."
154
   (let* ((graph (second (assoc 'spocq.a:|graph| statement-patterns)))
155
          (quads (loop for pattern in statement-patterns
156
                   if (triple-form-p pattern)
157
                   collect (if graph `(spocq.a:|quad| ,@(rest pattern) ,graph) pattern))))
158
     (if quads
159
         (if (rest quads)
160
             (reduce #'(lambda (field1 field2) `(spocq.a:|join| ,field1 ,field2)) quads)
161
             (first quads))
162
         `(spocq.a:|table| ,(expression-dimensions statement-patterns)))))
163
 
164
 (defmacro isparql:|bindings| (field variables)
165
   `(list 'spocq.a:|bindings|
166
          (loop for solution in ',field
167
            collect (loop for term in solution collect (object-term-number term)))
168
          ',variables))
169
 
170
 (defmacro isparql:|construct| (solution-field graph-pattern)
171
   `(list 'spocq.a:|construct| ',solution-field ',graph-pattern))
172
 
173
 (defmacro isparql:|extend| (field variable expression)
174
   `(list 'spocq.a:|extend| ,field ',variable ',expression))
175
 
176
 (defmacro isparql:|filter| (field expression)
177
   `(list 'spocq.a:|filter| ,field ',expression))
178
 
179
 (defmacro isparql:|graph| (name group-graph-pattern)
180
   (macroexpand-graph name group-graph-pattern))
181
 
182
 (defmacro isparql:|join| (field1 field2)
183
   `(list 'spocq.a:|join| ,field1 ,field2))
184
 
185
 (defmacro isparql:|leftjoin| (field1 field2)
186
   `(list 'spocq.a:|leftjoin| ,field1 ,field2))
187
 
188
 (defmacro isparql:|quad| (subject predicate object graph)
189
   ;; `(list 'spocq.a:|null| ',(expression-dimensions (list subject predicate object)))
190
   `(list 'spocq.a:|quad|
191
          ,(isparql::intern-term-form subject)
192
          ,(isparql::intern-term-form predicate)
193
          ,(isparql::intern-term-form object)
194
          ,(isparql::intern-term-form graph)))
195
 
196
 (defmacro isparql:|select| (field variables)
197
   (if (or (eql variables '*)
198
           (equal (sort variables #'string-lessp)
199
                  (expression-dimensions field)))
200
       field
201
       `(list 'spocq.a:|select| ,field ',variables)))
202
 
203
 (defmacro isparql:|table| (variables)
204
   `(list 'spocq.a:|table| ',variables))
205
 
206
 (defmacro isparql:|triple| (subject predicate object)
207
   ;; `(list 'spocq.a:|null| ',(expression-dimensions (list subject predicate object)))
208
   `(list 'spocq.a:|quad|
209
          ,(isparql::intern-term-form subject)
210
          ,(isparql::intern-term-form predicate)
211
          ,(isparql::intern-term-form object)
212
          (object-term-number |urn:dydra|:|default|)))
213
 
214
 (defmacro isparql:|union| (field1 field2)
215
   `(list 'spocq.a:|union| ,field1 ,field2))
216
 
217
 
218
 ;;; interpretation
219
 
220
 ;;; encapsulate the intermediate states of the respective nodes for a series of
221
 ;;; activations calls in order to evaluate combination forms
222
 
223
 (defstruct isparql:state
224
   (node-states (make-hash-table)))
225
 
226
 (defun isparql:node-state (state node)
227
   (gethash node (isparql:state-node-states state)))
228
 
229
 (defun (setf isparql:node-state) (node-state state node)
230
   (setf (gethash node (isparql:state-node-states state)) node-state))
231
 
232
 (defun isparql::intern-term-form (term)
233
   (cond ((variable-p term)
234
          `(quote ,term))
235
         ((spocq:blank-node-p term)
236
          `(quote ,(cons-symbol *variable-package* "?" (spocq:blank-node-label term))))
237
         (t
238
          `(object-term-number ,term))))
239
 
240
 (defun isparql:unify-terms (t1 t2)
241
   (cond ((or (variable-p t1) (variable-p t2)
242
              (spocq:blank-node-p t1) (spocq:blank-node-p t2))
243
          (values (list t1 t2) t))
244
         ((eql t1 t2) ;; two variables are not constant
245
          (values nil t))
246
         (nil
247
          nil)))
248
 
249
 (defun isparql:unify-statements (s1 s2)
250
   (loop with unified = nil
251
     with bindings = ()
252
     for position from 0
253
     for t1 in (statement-terms s1)
254
     for t2 in (statement-terms s2)
255
     do (multiple-value-bind (binding matched) (isparql:unify-terms t1 t2)
256
          (when (or matched
257
                    (and (= position 3) (or (eql t1 (symbol-term-id |urn:dydra|:|all|))
258
                                            (eql t2 (symbol-term-id |urn:dydra|:|all|)))))
259
            (setf unified t))
260
          (setf bindings (nconc binding bindings)))
261
     finally (return (values bindings unified))))
262
 
263
 (defun isparql::compatible-solutions? (s1 s2)
264
   (loop for (v1 v2) on s1 by #'cddr
265
     unless (cond ((variable-p v1)
266
                   (let ((s2-value (getf s2 v1)))
267
                     (or (null s2-value)
268
                         (eql s2-value v2))))
269
                  ((variable-p v2)
270
                   (let ((s2-value (getf s2 v2)))
271
                     (or (null s2-value)
272
                         (eql s2-value v1))))
273
                  (t
274
                   nil))
275
     return nil
276
     finally (return t)))
277
 
278
 (defun isparql::merge-solutions (s1 s2)
279
   (let ((result (copy-list s2)))
280
     (loop for (v1 v2) on s1 by #'cddr
281
       unless (if (variable-p v1)
282
                  (find v1 result)
283
                  (find v2 result))
284
       do (setf result (list* v1 v2 result)))
285
     result))
286
 
287
 (defun isparql::compute-plist-operator (expression)
288
   (let ((variables (expression-variables expression))
289
         (*macroexpand-bgp-phases* nil))
290
     (spocq-compile `(lambda (&key ,@(loop for var in variables collect `((,var ,var) nil))
291
                              &allow-other-keys)
292
                       (let ,(loop for var in variables collect `(,var (term-number-object ,var)))
293
                         ,expression)))))
294
 
295
 
296
 ;;; interpretation operators
297
 
298
 (defmacro def-isparql-op (operator (lambda-list statement state success) &body body)
299
   `(defmethod isparql:isparql-op ((operator (eql ',operator)) (whole t)
300
                           (,statement t) (,state t)
301
                           ,success)
302
      (destructuring-bind ,lambda-list (rest whole)
303
        ,@body)))
304
 
305
 (defgeneric isparql:isparql-op (operator whole statement state success)
306
   (:documentation
307
    "pass a statement over an activation net. collect incremental results at for
308
     operators which require materialization. emit results to the success
309
     continuation as they are generated.
310
 
311
    a final null statement is accepted to flush those pending solutions which
312
    require materialization. leaf nodes emit no solutions for there and
313
    intermeidate operator nodes flush colected solutions or compute final
314
    results."))
315
 
316
 (defun isparql:isparql (expression statement state success)
317
   (isparql:isparql-op (first expression) expression statement state success))
318
 
319
 
320
 ;;; operator implementations
321
 
322
 (def-isparql-op spocq.a:|ask| ((solution-field) statement state success)
323
   (flet ((success (solution)
324
            (funcall success solution)
325
            (return-from isparql:isparql-op solution)))
326
     (declare (dynamic-extent #'success))
327
     (isparql:isparql solution-field statement state #'success)
328
     ;; if that return for the end marker, nothing was found
329
     (unless statement
330
       (funcall success nil))))
331
   
332
 (def-isparql-op spocq.a:|bindings| ((solution-field dimensions) statement state success)
333
   (when statement
334
     (loop for values in solution-field
335
       do (funcall success (loop for variable in dimensions for term in values
336
                             collect variable collect term)))
337
     solution-field))
338
 
339
 (def-isparql-op spocq.a:|construct| ((solution-field graph-pattern) statement state success)
340
   ;; compile the generator to transform solutions into a graph genrator
341
   ;; for each solution, invoke the generator and continue with the consolidated graph
342
    (let ((node-operator (or (isparql:node-state state whole)
343
                              (setf (isparql:node-state state whole)
344
                                    (isparql::compute-plist-operator
345
                                     `(list ,@(loop for (nil s p o graph) in graph-pattern
346
                                                collect `(list 'spocq.a:|quad|
347
                                                               ,(isparql::intern-term-form s)
348
                                                               ,(isparql::intern-term-form p)
349
                                                               ,(isparql::intern-term-form o)
350
                                                               ,(isparql::intern-term-form graph)))))))))
351
       (flet ((success (solution)
352
                (let ((value (apply node-operator solution)))
353
                  (funcall success (apply node-operator solution)))))
354
         (declare (dynamic-extent #'success))
355
         (isparql:isparql solution-field statement state #'success))
356
      node-operator))
357
 
358
 (def-isparql-op spocq.a:|extend| ((solution-field variable expression) statement state success)
359
   (when statement
360
     (let ((node-operator (or (isparql:node-state state whole)
361
                              (setf (isparql:node-state state whole)
362
                                    (isparql::compute-plist-operator expression))))
363
           (count 0))
364
       (flet ((success (solution)
365
                (let ((value (apply node-operator solution)))
366
                  (incf count)
367
                  (funcall success (list* variable value solution)))))
368
         (declare (dynamic-extent #'success))
369
         (isparql:isparql solution-field statement state #'success))
370
       count)))
371
 
372
 (def-isparql-op spocq.a:|filter| ((solution-field test-expression &rest options) statement state success)
373
   (declare (ignore options))
374
   (let ((node-predicate (or (isparql:node-state state whole)
375
                             (setf (isparql:node-state state whole)
376
                                   (isparql::compute-plist-operator test-expression)))))
377
     (when statement
378
       (flet ((success (solution)
379
                (when (apply node-predicate solution)
380
                  (funcall success solution))))
381
         (declare (dynamic-extent #'success))
382
         (isparql:isparql solution-field statement state #'success)))
383
     node-predicate))
384
 
385
 (def-isparql-op spocq.a:|join| ((left-field right-field) statement state success)
386
   "once all patterns are satisfied, yield the solution"
387
   (let* ((node-state (or (isparql:node-state state whole)
388
                          (setf (isparql:node-state state whole)
389
                                (make-array 2 :initial-element nil))))
390
          (left-solutions (aref node-state 0))
391
          (right-solutions (aref node-state 1)))
392
     (flet ((emit-compatibles (base optional)
393
              ;;!!!timestamps: merge oldest|newest?
394
              (when (isparql::compatible-solutions? base optional)
395
                (let ((solution (isparql::merge-solutions base optional)))
396
                  (funcall success solution)
397
                  solution))))
398
       ;; handle first left solutions
399
       (flet ((success (solution)
400
                ;;!!!timestamps: constrain ttl
401
                (loop for right-solution in right-solutions
402
                  do (emit-compatibles solution right-solution))
403
                (push solution left-solutions)))
404
         (declare (dynamic-extent #'success))
405
         (isparql:isparql left-field statement state #'success))
406
       ;; then handle right solutions
407
       (flet ((success (solution)
408
                ;;!!!timestamps: constrain ttl
409
                (loop for left-solution in left-solutions
410
                  do (emit-compatibles left-solution solution))
411
                (push solution right-solutions)))
412
         (declare (dynamic-extent #'success))
413
         (isparql:isparql right-field statement state #'success)))
414
     (setf (aref node-state 0) left-solutions
415
           (aref node-state 1) right-solutions)
416
     node-state))
417
 
418
 (def-isparql-op spocq.a:|leftjoin| ((base-field optional-field) statement state success)
419
   "incrmentally collect base and optional solutions, yield result solutions for each respectively.
420
    retain unsatisfied base solutions to emit at conclusion"
421
   (let* ((node-state (or (isparql:node-state state whole)
422
                          (setf (isparql:node-state state whole)
423
                                (make-array 3 :initial-element nil))))
424
          (satisfied-base-solutions (aref node-state 0))
425
          (unsatisfied-base-solutions (aref node-state 1))
426
          (optional-solutions (aref node-state 2)))
427
     (flet ((emit-compatibles (base optional)
428
              (when (isparql::compatible-solutions? base optional)
429
                (let ((solution (isparql::merge-solutions base optional)))
430
                  (funcall success solution)
431
                  solution))))
432
       ;; handle first optional solutions
433
       (flet ((success (solution)
434
                (loop for base-solution in satisfied-base-solutions
435
                  do (emit-compatibles base-solution solution))
436
                (setf unsatisfied-base-solutions
437
                      (loop for base-solution in unsatisfied-base-solutions
438
                        if (emit-compatibles base-solution solution)
439
                        do (push base-solution satisfied-base-solutions)
440
                        else collect base-solution))))
441
         (declare (dynamic-extent #'success))
442
         (isparql:isparql optional-field statement state #'success))
443
       ;; then handle base solutions
444
       (flet ((success (solution)
445
                (if (loop with matched? = nil
446
                      for optional-solution in optional-solutions
447
                      if (emit-compatibles solution optional-solution)
448
                      do (setf matched? t)
449
                      finally (return matched?))
450
                    (push solution satisfied-base-solutions)
451
                    (push solution unsatisfied-base-solutions))))
452
         (declare (dynamic-extent #'success))
453
         (isparql:isparql base-field statement state #'success)))
454
     (setf (aref node-state 0) satisfied-base-solutions
455
           (aref node-state 1) unsatisfied-base-solutions
456
           (aref node-state 2) optional-solutions)
457
     (unless statement
458
       (loop for solution on unsatisfied-base-solutions
459
         do (funcall success solution)))
460
     node-state))
461
 
462
 (def-isparql-op spocq.a:|quad| ((&rest quad-terms) statement state success)
463
   (when statement
464
     ;;!!!timestamps : inroduce a timestamp
465
     (let ((solution (isparql:unify-statements quad-terms statement)))
466
       (when solution
467
         (funcall success solution)
468
         solution))))
469
 
470
 (def-isparql-op spocq.a:|select| ((solution-field dimensions) statement state success)
471
   (flet ((success (solution)
472
            (funcall success (loop with projection = ()
473
                               for dimension in dimensions
474
                               for value = (getf solution dimension dimensions)
475
                               unless (eq value dimensions)
476
                               do (setf (getf projection dimension) value)
477
                               finally (return projection)))))
478
     (declare (dynamic-extent #'success))
479
     (isparql:isparql solution-field statement state #'success)))
480
 
481
 (def-isparql-op spocq.a:|table| ((dimensions) statement state success)
482
   (declare (ignore dimensions))
483
   (when statement
484
     (funcall success nil)))
485
 
486
 (def-isparql-op spocq.a:|union| ((left-field right-field) statement state success)
487
   "pass the constituent solutions through unchanged"
488
   (let ((count 0))
489
     (flet ((success (solution)
490
              (incf count)
491
              (funcall success solution)))
492
       (declare (dynamic-extent #'success))
493
       (isparql:isparql left-field statement state #'success)
494
       (isparql:isparql right-field statement state #'success))
495
     count))
496
 
497
 ;;; the interface operators 
498
 
499
 (defgeneric compile-isparql (expression)
500
   (:method ((expression string))
501
     (compile-isparql (parse-sparql expression)))
502
   (:method ((expression cons))
503
     (let ((*macroexpand-hook* 'macroexpand-isparql)
504
           (*macroexpand-bgp-phases* nil))
505
       (values (spocq-compile `(lambda () ,expression))
506
               expression))))
507
 ;;; (compile-isparql "select * where { bind (1 as ?s) }")
508
 
509
 (defgeneric run-isparql (expression source &key repository-id agent success)
510
   (:documentation
511
   "Accept a SPARQL expression, transform it into an activation tree and
512
    pass all sourced statements through the tree to a given continutation or
513
    collect and return them.")
514
 
515
   (:method ((expression t) (source list) &rest args)
516
     (declare (dynamic-extent args))
517
     (flet ((source-function ()
518
              (pop source)))
519
       (declare (dynamic-extent #'source-function))
520
       (apply #'run-isparql expression #'source-function args)))
521
 
522
   (:method ((expression string) source &rest args)
523
     (declare (dynamic-extent args))
524
     (apply #'run-isparql (compile-isparql expression) source args))
525
 
526
   (:method ((expression cons) source &rest args)
527
     (declare (dynamic-extent args))
528
     (apply #'run-isparql (compile-isparql expression) source args))
529
 
530
   (:method ((graph-generator function) (source function) &key repository-id (agent (system-agent)) success)
531
     (let ((activation-graph (with-open-repository (repository-id :agent agent) (funcall graph-generator)))
532
           (solutions nil)
533
           (state (make-state )))
534
       (flet ((success (solution)
535
                (push (loop for (v1 v2) on solution by #'cddr
536
                        collect (if (variable-p v1) v1 (term-number-object v1))
537
                        collect (if (variable-p v2) v2 (term-number-object v2)))
538
                      solutions))
539
              (intern-statement (statement)
540
                (cons (pop statement)
541
                      (loop for term in statement
542
                        collect (cond ((variable-p term)
543
                                       term)
544
                                      ((spocq:blank-node-p term)
545
                                       (cons-symbol *variable-package* "?" (spocq:blank-node-label term)))
546
                                      (t
547
                                       (object-term-number term)))))))
548
         (declare (dynamic-extent #'success))
549
         ;; pass all stateements through the activation tree, collecting solutions
550
         ;; as the last step pass NIL to flush anything which depends on completion
551
         (unless success (setf success #'success))
552
         (loop for statement = (funcall source)
553
           until (null statement)
554
           do (isparql:isparql activation-graph (intern-statement statement) state #'success)
555
           finally (isparql:isparql activation-graph nil state #'success)))
556
       (values solutions
557
               activation-graph))))
558
 
559
 (defgeneric compute-isparql-processor (expression &key continuation repository-id agent state)
560
   (:documentation
561
   "Accept a SPARQL expression, transform it into an activation tree and return
562
    a function which accepts statements, passes each statements through the tree
563
    and yields results to a continutation.
564
    Both the continuation and the activation state can be provided to create the
565
    operator and/or on each invocation.")
566
 
567
   (:method ((expression string) &rest args)
568
     (declare (dynamic-extent args))
569
     (apply #'compute-isparql-processor (compile-isparql expression) args))
570
 
571
   (:method ((expression cons) &rest args)
572
     (declare (dynamic-extent args))
573
     (apply #'compute-isparql-processor (compile-isparql expression) args))
574
 
575
   (:method ((graph-generator function) &key continuation (state (make-state ))
576
             (repository-id (error "repository-id is required"))
577
             (agent (system-agent)))
578
     (let ((activation-graph (with-open-repository (repository-id :agent agent) (funcall graph-generator))))
579
       (flet ((intern-statement (statement)
580
                (when statement
581
                  (cons (pop statement)
582
                        (loop for term in statement
583
                          collect (cond ((variable-p term)
584
                                         term)
585
                                        ((spocq:blank-node-p term)
586
                                         (cons-symbol *variable-package* "?" (spocq:blank-node-label term)))
587
                                        (t
588
                                         (object-term-number term))))))))
589
         (flet ((apply-graph (statement &key (continuation continuation) (state state))
590
                  (isparql:isparql activation-graph (intern-statement statement) state
591
                                   (or continuation #'identity))))
592
           (values #'apply-graph 
593
                   activation-graph))))))
594
 #+(or)
595
 (
596
 ;; not used as the bgp are deconstructed
597
 
598
 (def-isparql-op spocq.a:|bgp| ((&rest triple-patterns) statement state success)
599
   "once all patterns are satisfied, yield the solution"
600
   (when statement
601
     (let* ((node-state (or (isparql:node-state state whole)
602
                            (setf (isparql:node-state state whole)
603
                                  (make-array (length triple-patterns) :initial-element nil))))
604
            (match-state (make-array (length node-state) :initial-element nil)))
605
       (flet ((match-pattern (triple-pattern)
606
                (multiple-value-bind (solutions matched)
607
                                     (isparql:unify-statements triple-pattern statement)
608
                  ;;!!! this does not handle constant statement pairs which match
609
                  (when matched solutions))))
610
         (declare (dynamic-extent #'match-pattern))
611
         (map-into match-state #'match-pattern triple-patterns)
612
         (when (every #'(lambda (n m) (or n m)) node-state match-state)
613
           (loop for solution in (isparql:solution-products match-state node-state)
614
             do (funcall success solution))
615
           (map-into node-state #'(lambda (match node) (cons match node))
616
                     match-state node-state)
617
           node-state)))))
618
 
619
 (defun isparql:solution-products (statement-matches collected-matches)
620
   "combine the solutions from a given new statement with those from previous statements
621
    to produce the joined product"
622
   (let ((product (list nil)))
623
     (labels ((compatible? (s1 s2)
624
                (isparql::compatible-solutions? s1 s2))
625
              (merge-solutions (s1 s2)
626
                (isparql::merge-solutions s1 s2))
627
              (combine-solution (solution product)
628
                (loop for product-solution in product
629
                  when (compatible? solution product-solution)
630
                  collect (merge-solutions solution product-solution))))
631
       ; (print (list statement-matches collected-matches))
632
       (loop for statement-match across statement-matches
633
         for collected-match-set across collected-matches
634
         if statement-match
635
         do (setf product (combine-solution statement-match product))
636
         else do (setf product
637
                       (loop for collected-match in collected-match-set
638
                         append (combine-solution collected-match product)))))
639
     product))
640
 )
641