Skip to content

Instantly share code, notes, and snippets.

@nixin72
Created February 5, 2020 21:00
Show Gist options
  • Save nixin72/39d19aa109adede5ace4fba9035956c1 to your computer and use it in GitHub Desktop.
Save nixin72/39d19aa109adede5ace4fba9035956c1 to your computer and use it in GitHub Desktop.
(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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment