(module relations mzscheme
  
  ;; A small module to prototype what kind of relational stuff I'll
  ;; need.
  ;;
  ;; Note: this is not optimized at all yet.  I probably want a different
  ;; implementation that uses a real relational database rather than
  ;; a bunch of lists.
  
  (require (lib "list.ss")
           (only (lib "1.ss" "srfi") lset-union lset-difference take last))
  
  (provide struct:context context context?
           (rename -make-context make-context)
           context-set!
           context-get
           
           
           struct:tuple tuple tuple?
           (rename -make-tuple make-tuple)
           tuple->list
           list->tuple
           tuple-equal?
           
           
           struct:relation relation relation?
           (rename -make-relation make-relation)
           make-singleton-relation
           relation-size
           
           relation->list
           list->relation
           
           relation-add
           relation-subtract
           relation-cross
           relation-natural-join)
  
  
  
  ;; The current context.
  ;; A context maps a name to a relation, and presents an
  ;; environment for doing get/set! actions that should
  ;; persist.
  (define-struct context (relations))
  
  ;; make-context: -> context
  (define (-make-context)
    (make-context (make-hash-table)))
  
  ;; context-set!: context symbol relation -> void
  (define (context-set! a-context a-name a-relation)
    (hash-table-put! (context-relations a-context) a-name a-relation))
  
  ;; context-get: context symbol 
  (define (context-get a-context a-name)
    (hash-table-get
     (context-relations a-context) a-name
     (lambda ()
       (let ([r (-make-relation)])
         (hash-table-put! (context-relations a-context) a-name r)
         r))))
  
  
  
  
  
  ;; A tuple is a row of values.
  (define-struct tuple (vals))
  
  ;; make-tuple: val* -> tuple
  (define (-make-tuple . vals)
    (make-tuple vals))
  
  ;; tuple->list: tuple -> (listof val)
  (define (tuple->list a-tuple)
    (tuple-vals a-tuple))
  
  ;; list->tuple: (listof val) -> tuple
  (define (list->tuple vals)
    (make-tuple vals))
  
  ;; tuple-arity: tuple -> number
  ;; Returns how many elements are in the tuple
  (define (tuple-arity a-tuple)
    (length (tuple-vals a-tuple)))
  
  ;; tuple-equal?: tuple tuple -> boolean
  (define (tuple-equal? tuple-1 tuple-2)
    (equal? (tuple-vals tuple-1) (tuple-vals tuple-2)))
  
  ;; tuple-empty? tuple -> boolean
  ;; Returns true if the tuple is empty
  (define (tuple-empty? a-tuple)
    (empty? (tuple-vals a-tuple)))
  
  ;; tuple-first: tuple -> val
  (define (tuple-first a-tuple)
    (first (tuple-vals a-tuple)))
  
  ;; tuple-last: tuple -> val
  (define (tuple-last a-tuple)
    (last (tuple-vals a-tuple)))
  
  ;; tuple-butfirst: tuple -> tuple
  (define (tuple-butfirst a-tuple)
    (make-tuple (rest (tuple-vals a-tuple))))
  
  ;; tuple-butlast: tuple -> tuple
  (define (tuple-butlast a-tuple)
    (make-tuple (take (tuple-vals a-tuple) (sub1 (tuple-arity a-tuple)))))
  
  ;; tuple-concat: tuple tuple -> tuple
  (define (tuple-concat tuple-1 tuple-2)
    (make-tuple (append (tuple-vals tuple-1) (tuple-vals tuple-2))))
  
  
  
  ;; A relation is a collection of tuples.
  ;; It maintains its own unique id, a context, and
  ;; its set of tuples.
  (define-struct relation (id context tuples))
  
  
  ;; -make-relation: tuple* -> relation
  ;; FIXME: check arities of each tuple!
  (define (-make-relation . tuples)
    (make-relation #f #f tuples))
  
  
  ;; make-singleton-relation: val* -> relation
  (define (make-singleton-relation . vals)
    (make-relation #f #f (list (make-tuple vals))))
  
  
  ;; relation-size: relation -> number
  ;; Returns the number of tuples in the relation.
  (define (relation-size a-relation)
    (length (relation-tuples a-relation)))
  
  
  ;; relation->list: relation -> (listof tuple)
  (define (relation->list a-relation)
    (map tuple->list (relation-tuples a-relation)))
  
  
  ;; list->relation: (listof (listof val)) -> relation
  (define (list->relation val-lists)
    (make-relation #f #f (map list->tuple val-lists)))
  
  
  ;; relation-add: relation relation -> relation
  ;; Add one relation to another
  ;; Note: hideous implementation.
  ;; FIXME: check respective arities first!
  (define (relation-add relation-1 relation-2)
    (list->relation (lset-union equal?
                                (relation->list relation-1)
                                (relation->list relation-2))))
  
  
  ;; relation-subtract: relation relation -> relation
  ;; Again, this is implemented in a terribly inefficient
  ;; way.
  ;; FIXME: check arities!
  (define (relation-subtract relation-1 relation-2)
    (list->relation (lset-difference equal?
                                     (relation->list relation-1)
                                     (relation->list relation-2))))

  
  ;; list-cross-fold: (X Y Z -> Z) Z (listof X) (listof Y) -> Z
  ;; Does a cross fold of f across elements of l1 and l2.
  (define (list-cross-fold f acc l1 l2)
    (foldl (lambda (l acc) (foldl (lambda (r acc) (f l r acc)) acc l2))
           acc l1))
  
  
  ;; relation-cross: relation relation -> relation
  (define (relation-cross relation-1 relation-2)
    (let* ([t1 (relation-tuples relation-1)]
           [t2 (relation-tuples relation-2)]
           [inner-loop (lambda (left right acc)
                         (cons (make-tuple
                                (append (tuple-vals left) (tuple-vals right)))
                               acc))])
      (let ([new-tuples (list-cross-fold inner-loop '() t1 t2)])
        (make-relation #f #f new-tuples))))
  
  
  ;; relation-natural-join: relation relation -> relation
  (define (relation-natural-join relation-1 relation-2)
    (let ([f
           (lambda (l r acc)
             (cond
               [(or (tuple-empty? l) (tuple-empty? r)) acc]
               [(equal? (tuple-last l) (tuple-first r))
                (cons (tuple-concat (tuple-butlast l) (tuple-butfirst r))
                      acc)]
               [else acc]))])
      (make-relation #f #f
                     (list-cross-fold f
                                      '()
                                      (relation-tuples relation-1)
                                      (relation-tuples relation-2))))))