Coverage report: /development/source/library/org/datagraph/spocq-shard/src/extensions/inference/rule-library.lisp

KindCoveredAll%
expression0438 0.0
branch016 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 manags rule libraries in the 'org.datagraph.spocq' RDF engine."
6
   (copyright
7
   "Copyright 2019 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
8
   (long-description
9
    "Rules are described in various ways in rdf datasets.
10
     Each library composes the rules from the list of datasets provided as
11
     its :path when instantiated.
12
     These are loaded and compiled into an ordered set of various rule types.
13
     - construct-rule : used to transform a bgp
14
     - construct-rule : used to augment inserted statements
15
     - ask-rule : used to effect constraints on repositry state.
16
     When a task involves rules, it constructs and binds a processor which
17
     integrates the appropriate kinds of rules.
18
 
19
     The rule libraries and the processors must be loaded on reference as
20
     they involve compilation and attempts to instantiate them while a
21
     query is being compiled will deadlock."))
22
 
23
 (defvar *entailment-precedence-property* |spin|:|nextRuleProperty|)
24
 
25
 (defclass graph-rewrite-processor ()
26
   ((rules :initform (make-hash-table :test #'equalp) :initarg :rules
27
               :reader graph-rewrite-processor-rules)
28
    (groups :initform (make-hash-table :test #'equalp) :initarg :groups
29
            :reader graph-rewrite-processor-groups)
30
    (rule-list :initform nil :writer (setf graph-rewrite-processor-rule-list) :reader get-graph-rewrite-processor-rule-list)
31
    (model-repository :initarg :model-repository :reader graph-rewrite-processor-model-repository)
32
    (statement-processor :initform nil :writer (setf graph-rewrite-processor-statement-processor) :reader get-graph-rewrite-processor-statement-processor)
33
    (statement-processor-expression :initform nil :accessor graph-rewrite-processor-statement-processor-expression))
34
   (:documentation "a graph-rewrite-processor combines the library and model
35
     repositories, the library's construct rules and its groups and the compiled
36
     statement activation processor, which accepts statement patterns, unifies
37
     them with the rules and yields matches rules and the respective inification
38
     maps."))
39
    
40
 
41
 (defclass rule ()
42
   ((name :initarg :name :reader rule-name)
43
    (priority :initform nil :initarg :priority :accessor rule-priority)
44
    (group :initform nil :initarg :group :accessor rule-group)
45
    (next-rules :initform () :initarg :next-rules :accessor rule-next-rules)
46
    (successors :initform () :initarg :successors :accessor rule-successors
47
                :documentation "the inclusive closure of the next rules"))
48
   (:documentation ""))
49
 
50
 (defclass ask-rule (rule)
51
   ((text :initarg :text :reader rule-text)
52
    (symbolic-expression :initarg :symbolic-expression :reader rule-symbolic-expression)
53
    )
54
   (:documentation ""))
55
 
56
 (defclass construct-rule (rule)
57
   ((text :initarg :text :reader rule-text)
58
    (symbolic-expression :initarg :symbolic-expression :reader rule-symbolic-expression)
59
    )
60
   (:documentation ""))
61
 
62
 (defclass update-rule (rule)
63
   ((text :initarg :text :reader rule-text)
64
    (symbolic-expression :initarg :symbolic-expression :reader rule-symbolic-expression)
65
    )
66
   (:documentation ""))
67
 
68
 (defclass active-rule ()
69
   ((rule :initarg :rule :reader active-rule-rule)
70
    (bindings :initarg :bindings :reader active-rule-bindings))
71
   (:documentation ""))
72
 
73
 (defgeneric active-rule-name (active-rule)
74
   (:method ((active-rule active-rule))
75
     (rule-name (active-rule-rule active-rule))))
76
 
77
 (defgeneric rule-symbolic-expression (active-rule)
78
   (:method ((active-rule active-rule))
79
     (rule-symbolic-expression (active-rule-rule active-rule))))
80
 
81
 (defgeneric active-rule-antecedent (rule)
82
   (:method ((active-rule active-rule))
83
     (let ((sse (rule-symbolic-expression active-rule))
84
           (map (active-rule-bindings active-rule)))
85
       (sublis map (second sse)))))
86
 (defgeneric active-rule-consequent (rule)
87
   (:method ((active-rule active-rule))
88
     (let ((sse (rule-symbolic-expression active-rule))
89
           (map (active-rule-bindings active-rule)))
90
       (sublis map (third sse)))))
91
 
92
 (defmethod print-object ((object rule) stream)
93
   (_print-unreadable-object (object stream :identity t :type t)
94
     (format stream "~a (~@[~a~]~@[@~a~])"
95
             (rule-name object)
96
             (let ((g (rule-group object))) (when g (rule-group-name g)))
97
             (rule-priority object))))
98
 
99
 (defmethod initialize-instance ((instance active-rule) &rest initargs &key
100
                                 bindings rule)
101
   (unless (consp (first bindings))
102
     (setf bindings (loop for (var value) on bindings by #'cddr collect (cons var value))))
103
   (let* ((e-variables (expression-variables (rule-symbolic-expression rule)))
104
         (free-variables (set-difference e-variables
105
                                         (loop for (var . nil) in bindings
106
                                           when (variable-p var) collect var))))
107
     (loop for var in free-variables
108
       do (setf bindings (acons var (cons-variable) bindings))))
109
   (apply #'call-next-method instance
110
          :bindings bindings
111
          initargs))
112
 
113
 (defmethod initialize-instance ((instance construct-rule) &rest initargs &key
114
                                 name text (symbolic-expression (when text (parse-sparql text))))
115
   (declare (ignore name))
116
   (apply #'call-next-method instance
117
          :symbolic-expression symbolic-expression
118
          initargs))
119
 
120
 (defclass rule-group ()
121
   ((name :initarg :name :reader rule-group-name)
122
    (members :initarg :members :initform () :accessor rule-group-members)
123
    (next-groups :initarg :next-groups :initform () :accessor rule-group-next-groups)
124
    (successors :initarg :successors :initform () :accessor rule-group-successors
125
                :documentation "the inclusive closure of the next groups")))
126
 
127
 (defmethod print-object ((object rule-group) stream)
128
   (_print-unreadable-object (object stream :identity t :type t)
129
     (format stream "~a"
130
             (rule-group-name object))))
131
 
132
 
133
 (defgeneric graph-rewrite-processor (library model)
134
   (:documentation "Import from a library those rules which concern basic graph
135
    pattern expansion.")
136
   (:method ((library rule-library) (model repository))
137
     (or (get-aspect-cache (list :graph-rewrite-processor (rule-library-path library)) :repository model)
138
         (setf (get-aspect-cache (list :graph-rewrite-processor (rule-library-path library)) :repository model)
139
               (make-graph-rewrite-processor library model)))))
140
 
141
 (defgeneric (setf graph-rewrite-processor) (processor library model)
142
   (:method (processor (library repository) (model repository))
143
     (setf (get-aspect-cache  (list :graph-rewrite-processor (rule-library-path library)) :repository model)
144
           processor)))
145
 
146
 (defgeneric make-graph-rewrite-processor (library model)
147
   (:documentation "load rules to expand basic graph patterns. three forms are
148
    recognized:
149
    - <name> sp:text 'a sparql construct query' : of ask/construct/select, just the construct expressions
150
    - <name> a spin:ConstrucTemplate; spin:body [ a sp:Construct; sp:text 'a sparql construct query' ]
151
    - [antecedent graph] log:implies [consequent graph] # single-level n3 rules, which supports no prcedence")
152
 
153
   (:method ((library rule-library) (model repository))
154
     (let* ((rules (rule-library-construct-rules library))
155
            (groups (rule-library-groups library))
156
            (processor (make-instance 'graph-rewrite-processor
157
                         :model-repository model
158
                         :rules rules
159
                         :groups groups)))
160
       ;; generate the statement processor in order to compile the activation graph
161
       ;; this applies even if just macroexpaning as it invokes the compiler
162
       (graph-rewrite-processor-statement-processor processor)
163
       (values processor
164
               (graph-rewrite-processor-rule-list processor)))))
165
 
166
 
167
 (defgeneric load-rule-library (library)
168
   (:documentation "Load library rules. three kinds are recognized
169
    - ask
170
    - construct
171
    - update
172
    Of the construct kind, three forms are recognized:
173
    - <name> sp:text 'a sparql construct query' : of ask/construct/select, just the construct expressions
174
    - <name> a spin:ConstrucTemplate; spin:body [ a sp:Construct; sp:text 'a sparql construct query' ]
175
    - [antecedent graph] log:implies [consequent graph] # single-level n3 rules, which supports no prcedence
176
    The ask and update kinds follow the construct template pattern, but are typed as
177
    AskTemplate and UpdateTemplate:")
178
 
179
   (:method ((library rule-library))
180
     ;;!!! if simultaneous rule update and query maters, one could make this threadsafe with lock
181
     (let* ((rule-declarations (read-library-rules library))
182
            (ask-rules (rule-library-ask-rules library))
183
            (construct-rules (rule-library-construct-rules library))
184
            (update-rules (rule-library-update-rules library))
185
            (groups (rule-library-groups library))
186
            (rules (make-hash-table :test #'equalp)))
187
       (clrhash ask-rules)
188
       (clrhash construct-rules)
189
       (clrhash update-rules)
190
       (clrhash groups)
191
       (destructuring-bind (&key sparql-rules spin-asks spin-constructs spin-updates
192
                                 n3-rules group-relations group-compositions)
193
                           rule-declarations
194
       ;; construct rule collection graph to use to sprt rules
195
       ;; named constructs are simple constructs to be parsed
196
       (loop for (name text) in sparql-rules
197
         when (iri-p name)
198
         do (setf (gethash name construct-rules)
199
                  (setf (gethash name rules)
200
                        (make-instance 'construct-rule :name name :text text))))
201
       (loop for (name text) in spin-asks
202
         do (setf (gethash name ask-rules)
203
                  (setf (gethash name rules)
204
                        (make-instance 'ask-rule :name name :text text))))
205
       (loop for (name text) in spin-constructs
206
         do (setf (gethash name construct-rules)
207
                  (setf (gethash name rules)
208
                        (make-instance 'construct-rule :name name :text text))))
209
       (loop for (name text) in spin-updates
210
         do (setf (gethash name update-rules)
211
                  (setf (gethash name rules)
212
                        (make-instance 'update-rule :name name :text text))))
213
       (loop with collation = ()
214
         for (name sa pa oa sc pc oc) in n3-rules
215
         for rule = (getf collation name)
216
         ;; filter union
217
         do (unless (spocq:unbound-variable-p sa) (push (list sa pa oa) (getf rule :antecedents)))
218
         do (unless (spocq:unbound-variable-p sc) (push (list sc pc oc) (getf rule :consequents)))
219
         do (setf (getf collation name) rule)
220
         finally (loop for (name elements) on collation by #'cddr
221
                   do (setf (gethash name rules)
222
                            (setf (gethash name rules)
223
                                  (make-instance 'construct-rule
224
                                    :name name
225
                                    :symbolic-expression `(spocq.a:|construct|
226
                                                                   (spocq.a:|bgp|
227
                                                                            ,@(loop for spo in (getf elements :antecedents)
228
                                                                                collect `(spocq.a:|triple| ,@spo)))
229
                                                                   ,(loop for spo in (getf elements :consequents)
230
                                                                      collect `(spocq.a:|triple| ,@spo))))))))
231
       (loop for (group-name rule-name priority) in group-compositions
232
         for rule = (gethash rule-name rules)
233
         for group = (or (gethash group-name groups)
234
                         (setf (gethash group-name groups) (make-instance 'rule-group :name group-name)))
235
         when (eql (char (iri-local-part priority) 0) #\_)
236
         do (cond (rule
237
                   (setf (rule-priority rule) (spocq.e:str priority))
238
                   (setf (rule-group rule) group)
239
                   (push rule (rule-group-members group)))
240
                  (t
241
                   (warn "group missing rule: (~s ~s ~s)" group-name rule-name priority))))
242
         ;; order all groups together
243
         ;; should be no cross references between groups
244
       (loop for (group-name next-group-name) in group-relations
245
         for group = (or (gethash group-name groups)
246
                         (warn "missing group: ~s" group-name))
247
         for next-group = (or (gethash next-group-name groups)
248
                         (warn "missing group: ~s" next-group-name))
249
         when (and group next-group)
250
         do (push next-group (rule-group-next-groups group)))
251
       (labels ((next-groups (group) 
252
                  (or (rule-group-successors group)
253
                      (setf (rule-group-members group)
254
                            (sort (rule-group-members group) #'spocq.e:< :key #'rule-priority)
255
                            (rule-group-successors group)
256
                            (append (list group)
257
                                    (reduce #'append (rule-group-next-groups group) :key #'next-groups)))))
258
                (next-rules (rule)
259
                  (or (rule-successors rule)
260
                      (setf (rule-successors rule)
261
                            (let ((group (rule-group rule)))
262
                              (when group
263
                                (append (rest (member rule (rule-group-members group)))
264
                                        (reduce #'append (rest (rule-group-successors group)) :key #'rule-group-members))))))))
265
         (loop for element being each hash-value of groups
266
           do (next-groups element))
267
         (loop for element being each hash-value of rules
268
           do (next-rules element)))
269
         library))))
270
 
271
 ;;; there should be one operator each for
272
 ;;; - rewrite rules
273
 ;;; - validation constraints
274
 ;;; - construct rules
275
 ;;; - events ?
276
 
277
 
278
 (defgeneric read-library-rules (library)
279
   (:documentation "read and collate rewrite rules from the library's repositories.
280
    recognized:
281
    - <name> sp:text 'a sparql construct query' : of ask/construct/select, just the construct expressions
282
    - <name> a spin:ConstrucTemplate; spin:body [ a sp:Construct; sp:text 'a sparql construct query' ]
283
    - [antecedent graph] log:implies [consequent graph] # single-level n3 rules, which supports no prcedence")
284
 
285
   (:method ((library rule-library))
286
     (let ((sparql-rules ())
287
           (spin-asks ())
288
           (spin-constructs ())
289
           (spin-updates ())
290
           (n3-rules ())
291
           (group-relations ())
292
           (group-compositions ()))
293
       (loop for repository in (rule-library-repositories library)
294
         for rules = (read-library-rules repository)
295
         do (setf sparql-rules (append sparql-rules (getf rules :sparql-rules))
296
                  spin-constructs (append spin-constructs (getf rules :spin-constructs))
297
                  n3-rules (append n3-rules (getf rules :n3-rules))
298
                  group-relations (append group-relations (getf rules :group-relations))
299
                  group-compositions (append group-compositions (getf rules :group-compositions))))
300
       (list :sparql-rules sparql-rules
301
             :spin-asks spin-asks
302
             :spin-constructs spin-constructs
303
             :spin-updates spin-updates
304
             :n3-rules n3-rules
305
             :group-relations group-relations
306
             :group-compositions group-compositions)))
307
 
308
   (:method ((repository-id string))
309
     (read-library-rules (repository repository-id)))
310
 
311
   ;; these should be pre-parsed
312
   (:method ((library repository))
313
     (let* ((*macroexpand-bgp-phases* nil)
314
            (sparql-rules (run-sparql-internal  "prefix sp: <http://spinrdf.org/sp#> select ?name ?text where {?name sp:text ?text}"
315
                                         :repository-id (repository-id library)
316
                                         :agent (system-agent)))
317
            (spin-constructs (run-sparql-internal "prefix sp: <http://spinrdf.org/sp#> prefix spin: <http://spinrdf.org/spin#> select ?name ?text where {?name a spin:ConstructTemplate ; spin:body [ a sp:Construct; sp:text ?text ]}"
318
                                        :repository-id (repository-id library)
319
                                        :agent (system-agent)))
320
            (spin-asks (run-sparql-internal "prefix sp: <http://spinrdf.org/sp#> prefix spin: <http://spinrdf.org/spin#> select ?name ?text where {?name a spin:AskTemplate ; spin:body [ a sp:Construct; sp:text ?text ]}"
321
                                        :repository-id (repository-id library)
322
                                        :agent (system-agent)))
323
            (spin-updates (run-sparql-internal "prefix sp: <http://spinrdf.org/sp#> prefix spin: <http://spinrdf.org/spin#> select ?name ?text where {?name a spin:UpdateTemplate ; spin:body [ a sp:Construct; sp:text ?text ]}"
324
                                        :repository-id (repository-id library)
325
                                        :agent (system-agent)))
326
            (n3-rules (run-sparql-internal  "
327
 prefix log: <http://www.w3.org/2000/10/swap/log/>
328
 select ?name ?sa ?pa ?oa ?sc ?pc ?oc ?antecedents ?consequents
329
 where { { { ?antecedents log:implies ?consequents . { graph ?antecedents {?sa ?pa ?oa} } }
330
           union
331
           { ?antecedents log:implies ?consequents . { graph ?consequents {?sc ?pc ?oc} } } }
332
         {?name log:antecedent ?antecedents . ?name log:consequent ?consequents} }"
333
                                       :repository-id (repository-id library)
334
                                       :agent (system-agent)))
335
            (group-relations (run-sparql-internal "prefix spin: <http://spinrdf.org/spin#> select ?groupName ?successorName
336
  where {?groupName spin:nextRuleProperty ?successorName}"
337
                               :repository-id (repository-id library)
338
                               :agent (system-agent)))
339
            (group-compositions (run-sparql-internal "prefix spin: <http://spinrdf.org/spin#> select ?groupName ?ruleName ?priority
340
  where {?groupName a rdf:Bag . ?groupName ?priority ?ruleName}"
341
                               :repository-id (repository-id library)
342
                               :agent (system-agent))))
343
 
344
       (list :sparql-rules sparql-rules
345
             :spin-asks spin-asks
346
             :spin-constructs spin-constructs
347
             :spin-updates spin-updates
348
             :n3-rules n3-rules
349
             :group-relations group-relations
350
             :group-compositions group-compositions))))
351
 
352
 (defgeneric graph-rewrite-processor-rule-list (graph-rewrite-processor)
353
   (:method ((processor graph-rewrite-processor))
354
     (or (get-graph-rewrite-processor-rule-list processor)
355
         (setf (graph-rewrite-processor-rule-list processor)
356
               (partial-order-sort (loop for rule being each hash-value of (graph-rewrite-processor-rules processor) collect rule)
357
                                   #'(lambda (r1 r2)
358
                                       ;;(print (list :sort r1 r2 (rule-successors r1)))
359
                                       (find r2 (rule-successors r1))))))))
360
 
361
 (defgeneric graph-rewrite-processor-statement-processor (graph-rewrite-processor)
362
   (:method ((processor graph-rewrite-processor))
363
     (or (get-graph-rewrite-processor-statement-processor processor)
364
         (let* ((model (graph-rewrite-processor-model-repository processor))
365
                (rule-forms (loop for rule in (graph-rewrite-processor-rule-list processor)
366
                              for sse = (rule-symbolic-expression rule)
367
                              for (op where pattern) = sse
368
                              collect `(spocq.a:|extend| (spocq.a:|bgp| ,@pattern) ?::?ruleName ,(rule-name rule))))
369
                (activation-expression (if (rest rule-forms)
370
                                           (reduce #'(lambda (f1 f2) `(spocq.a:|union| ,f1 ,f2)) rule-forms :from-end t)
371
                                           (first rule-forms))))
372
           (multiple-value-bind (function expression)
373
                                (compute-isparql-processor activation-expression :repository-id (repository-id model))
374
             (setf (graph-rewrite-processor-statement-processor-expression processor) expression)
375
             (setf (graph-rewrite-processor-statement-processor processor) function))))))
376
                 
377
 ;;; (load-graph-rewrite-processor "openrdf-sesame/inference" (repository "james/test"))
378