(defun make-cd (title artist rating ripped) (list :title title :artist artist :rating rating :ripped ripped)) (defvar *db* nil) (defun add-record (cd) (push cd *db*)) (defun dump-db () (format t "~{~{~a:~10t~a~%~}~%~}" *db*)) (defun prompt-read (prompt) (format *query-io* "~a: " prompt) (force-output *query-io*) (read-line *query-io*)) (defun prompt-for-cd () (make-cd (prompt-read "Title") (prompt-read "Artist") (or (parse-integer (prompt-read "Rating") :junk-allowed t) 0) (y-or-n-p "Ripped"))) (defun add-cds () (loop (add-record (prompt-for-cd)) (if (not (y-or-n-p "Another?")) (return)))) (defun save-db (filename) (with-open-file (out filename :direction :output :if-exists :supersede) (with-standard-io-syntax (print *db* out)))) (defun load-db (filename) (with-open-file (in filename) (with-standard-io-syntax (setf *db* (read in))))) (defun select (selector-fn) (remove-if-not selector-fn *db*)) (defun delete-rows (selector-fn) (setf *db* (remove-of selector-fn *db*))) (defun make-comparison-expr (field value) `(equal (getf cd ,field) ,value)) (defun make-update-expr (field value) `(setf (getf row ,field) ,value)) (defun make-some-list (foo fields) (loop while fields collecting (funcall foo (pop fields) (pop fields)))) (defmacro where (&rest clauses) `#'(lambda (cd) (and ,@(make-some-list 'make-comparison-expr clauses)))) (defmacro update (selector-fn &rest assignments) `(setf *db* (mapcar #'(lambda (row) (when (funcall ,selector-fn row) ,@(make-some-list 'make-update-expr assignments)) row) *db*)))