1 files changed, 76 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/rdf-index.scm b/src/scm/webid-oidc/rdf-index.scm
new file mode 100644
index 0000000..3875f91
--- /dev/null
+++ b/src/scm/webid-oidc/rdf-index.scm
@@ -0,0 +1,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)))))