summaryrefslogtreecommitdiff
path: root/datalog/relational-algebra2.scm
blob: 7bf87ce75e357eb5bd500e069aeba5d96fef1bd4 (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
77
78
79
80
81
; SPDX-FileCopyrightText: 2020 pukkamustard <pukkamustard@posteo.net>
;
; SPDX-License-Identifier: GPL-3.0-or-later

;; Some random notes on how to clean up the relational-algebra module.

(define-module (datalog relational-algebra2)
  #:use-module (schemantic lvar)

  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-43)
  #:use-module (srfi srfi-171)
  #:use-module (srfi srfi-171 meta))


;; Relational Algebra expressions are just trees. Operators are the nodes and relations are leafs.
;;
;; Instead of using goops it might be possible to use simple records with
;; transducers that define the operation of the node. This allows more streaming
;; evaluation and possibly even fibers.

(define-record-type <operator>
  (%make-operator type transducer children)
  operator?
  ;; the type is important for algebraic query rewriting. Does the node
  ;; represent a cartesian product or a selection? This info is in the transducer but
  ;; needs to be available before evaluation.
  (type operator-type)
  ;; performs the operation
  (transducer operator-transducer)
  ;; the children of the operator (the operands)
  (children operator-children))

(define-record-type <relation>
  (%make-relation predicate-symbol attributes)
  relation?
  (predicate-symbol relation-predicate-symbol)
  (attributes relation-attributes))

;; How to rewrite the query??
;; https://en.wikipedia.org/wiki/Relational_algebra#Use_of_algebraic_properties_for_query_optimization

;; Transducing a tree

(define-record-type <node>
  (make-node transducer-fn children)
  node?
  (transducer-fn node-transducer)
  (children node-children))

(define-record-type <leaf>
  (make-leaf values)
  leaf?
  (values leaf-values))

(define (node-reduce f identity node)
  (let* ((children (node-children node))
         (len (vector-length children)))
    (let loop ((i 0) (acc identity))
      (let* ((child-mask (make-bitvector 2 #f))
             (rf ((compose
                   (tmap (lambda (x) (cons child-mask x)))
                   (node-transducer node)) f)))
        (if (= i len)
            acc
            (loop (1+ i) (tree-reduce rf acc (vector-ref children i))))))))

(define (tree-reduce f identity tree)
  (if (leaf? tree)
      (list-reduce f identity (leaf-values tree))
      (node-reduce f identity tree)))

;; tree-transduce -> (rf)
(define (tree-transduce rf tree)
  (rf (tree-reduce rf (rf) tree)))

(tree-transduce rcons (make-node (tmap identity)
                                 (vector (make-leaf (list 1 2))
                                         (make-node (tmap identity)
                                                    (vector (make-leaf (list 3 4))
                                                            (make-leaf (list 5 6)))))))