db.lisp

(defun new-sym (s1 s2)
  (intern (concatenate 'string (string-upcase (string s1)) (string-upcase (string s2)))))

(defun make-key (str)
  (values (intern (string-upcase str) "KEYWORD")))

(defun dup-and-key (rows)
  (let ((data '()))
    (loop for row in rows do
          (setf data (cons row data))
          (setf data (cons (make-key row) data)))
    data))

(defun from (tables)
  (eval `(let ((dataset '()))
    ,(from-inner tables) dataset)))

(defun from-inner (tables &key (prev '()))
  (cond ((null tables) '())
        (t (setf row (new-sym (car tables) "-ROW"))
           (setf prev (cons row prev))
           `(loop for ,row in ,(car tables) do
             ,(cond ((null (cdr tables))
                       `(setf dataset (cons ,(cons 'list (dup-and-key prev)) dataset)))
                    (t (from-inner (cdr tables) :prev prev)))))))

(defun replace-cons (where-clause)
  (mapcar (lambda (clause)
            (cond ((symbolp clause)
                   (if (or (boundp clause) (fboundp clause)) clause `(quote ,clause)))
                  ((and (consp clause)
                        (not (listp (cdr clause))))
                   `(getf (getf row ,(make-key (new-sym (car clause) "-ROW")))
                          ,(make-key (cdr clause))))
                  ((listp clause) (replace-cons clause))
                  (t clause)))
          where-clause))

(defun where (dataset where-clause)
  (if (null where-clause) dataset
    (progn
      (setf where-clause (eval `(lambda (row) ,(replace-cons where-clause))))
      (loop for rows in dataset
            if (funcall where-clause rows)
            collect rows))))

(defun select (dataset columns)
  (setf columns (mapcar (lambda (r)
                          (eval `(lambda (row)
                                   (list ,(car (last r)) ,r))))
                        (replace-cons columns)))
  (loop for data in dataset collect
        (reduce #'append
                (loop for col in columns collect
                      (funcall col data)))))

(defun query (&key (select '* select?) (from nil from?) (where t where?))
  (cond ((and (not from?))
         "Must include a 'FROM' parameter")
        ((and from? (not select?) (not where?))
         (from from))
        ((and from? select? (not where?))
         (select (from from) select))
        ((and from? (not select?) where?)
         (where (from from) where))
        ((and from? select? where?)
         (select (where (from from) where) select))))

(query :select '((students . sid) (students . name))
       :from '(students courses courses-enrolled)
       :where '(and (eq (courses . name) COMP-353)
                    (eq (courses . cid) (courses-enrolled . cid))
                    (eq (students . sid) (courses-enrolled . sid))
                    (>= (courses-enrolled . grade) 3.4)))