blob: 3875f91189ffc08ba8c75bee68e4dcf42733eb5e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
(define-module (webid-oidc rdf-index)
#:use-module (oop goops)
#:use-module (rdf rdf)
#:export
(
with-index
))
(define-class <rdf-index> ()
(triples #:init-keyword #:triples #:getter triples)
(subject-index #:init-thunk (lambda () (make-hash-table))
#:getter subject-index)
(predicate-index #:init-thunk (lambda () (make-hash-table))
#:getter predicate-index)
(object-index #:init-thunk (lambda () (make-hash-table))
#:getter object-index))
(define (build-index triples)
(let ((ret (make <rdf-index> #:triples (list->vector triples))))
(define (do-index n triples)
(unless (null? triples)
(let ((first (car triples))
(rest (cdr triples)))
(let ((s (rdf-triple-subject first))
(p (rdf-triple-predicate first))
(o (rdf-triple-object first)))
(let ((other-s (hash-ref (subject-index ret) s '()))
(other-p (hash-ref (predicate-index ret) p '()))
(other-o (hash-ref (object-index ret) o '()))
(i (- n 1)))
(hash-set! (subject-index ret) s (cons i other-s))
(hash-set! (predicate-index ret) p (cons i other-p))
(hash-set! (object-index ret) o (cons i other-o))))
(do-index (- n 1) rest))))
(do-index (length triples) (reverse triples))
ret))
(define (intersection-2 a b)
(cond
((not a) b)
((not b) a)
((or (null? a) (null? b))
'())
((< (car a) (car b))
(intersection-2 (cdr a) b))
((> (car a) (car b))
(intersection-2 a (cdr b)))
(else
(cons (car a) (intersection-2 (cdr a) (cdr b))))))
(define (intersection a . rest)
(if (null? rest)
a
(let ((b (car rest))
(true-rest (cdr rest)))
(apply intersection (intersection-2 a b) true-rest))))
(define (rdf-match index subject predicate object)
(let ((by-subject (and subject (hash-ref (subject-index index) subject '())))
(by-predicate (and predicate (hash-ref (predicate-index index) predicate '())))
(by-object (and object (hash-ref (object-index index) object '()))))
(let ((indices (intersection by-subject by-predicate by-object)))
(define (accumulate-triples acc i)
(if (null? i)
(reverse acc)
(let ((t (vector-ref (triples index) (car i))))
(accumulate-triples (cons t acc) (cdr i)))))
(if indices
(accumulate-triples '() indices)
(vector->list (triples index))))))
(define (with-index graph f)
(let ((index (build-index graph)))
(f (lambda (s p o)
(rdf-match index s p o)))))
|
