(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)))))