Lisp to SQL compiler for Common Lisp
git clone
Log | Files | Refs | README | LICENSE

commit 8725f6f22872be7d7ebae3f3a7981affe3001baf
parent 6ed211c0fc72b6bf3f6f732fddf0664bf1b93efb
Author: Tomas Hlavaty <>
Date:   Mon,  1 Aug 2011 23:13:39 +0200

big rename

Mcore.lisp | 42++++++++++++++++++++++++------------------
Mpackages.lisp | 13++++++++-----
2 files changed, 32 insertions(+), 23 deletions(-)

diff --git a/core.lisp b/core.lisp @@ -1,22 +1,26 @@ +;;; Redefine EXECUTE, PRINT-SYMBOL and PRINT-STRING if needed. + (in-package :2sql) -(defun princ-string (string stream) +(defun print-string (string stream) (write-char #\' stream) (princ string stream) ;; TODO escape (write-char #\' stream)) -(defun princ-symbol (x stream) - (format stream "~(~{~a_~}~)" ;; TODO . - (split-sequence:split-sequence #\. (symbol-name x)))) +(defun split (char string) + (split-sequence:split-sequence char string)) + +(defun print-symbol (symbol stream) + (format stream "~(~{~a_~^.~}~)" (split #\. (symbol-name symbol)))) -(defun 2sql (form stream &optional (princ-symbol 'princ-symbol)) +(defun print-form (form stream) (let (qvars qchunks) (labels ((rec (x) (if (atom x) (etypecase x - (string (princ-string x stream)) + (string (print-string x stream)) (keyword (princ x stream)) - (symbol (funcall princ-symbol x stream)) + (symbol (print-symbol x stream)) (integer (princ x stream))) (ecase (car x) (:qvar @@ -40,31 +44,33 @@ (rec form)) (values (nreverse qvars) (nreverse qchunks)))) -(defun 2sql-string (form &optional (princ-symbol 'princ-symbol)) +(defun to-string (form) (let (qvars qchunks) (values (with-output-to-string (s) (multiple-value-setq (qvars qchunks) - (2sql (macroexpand form) s princ-symbol))) + (print-form (macroexpand form) s))) qvars qchunks))) -(defmacro 2sql-query (form) - (multiple-value-bind (str qvars qchunks) (2sql-string form) +(defun execute (q qvars) + (values q qvars)) + +(defmacro query (form) + (multiple-value-bind (str qvars qchunks) (to-string form) (flet ((paste (x) (when x `(list ,@x)))) - `(values ;; execute + `(execute ,(if qchunks `(format nil ,str ,@(mapcar (lambda (x) `(progn ,@x)) qchunks)) str) - ,(paste (mapcar #'car qvars)) - ,(paste (mapcar #'cdr qvars)))))) + ,qvars)))) -(defmacro 2sql-lambda (args &body body) +(defmacro qlambda (args &body body) `(lambda ,args - ,@(mapcar (lambda (q) `(2sql-query ,q)) body))) + ,@(mapcar (lambda (q) `(query ,q)) body))) -(defmacro define-2sql-function (name args &body body) +(defmacro define-function (name args &body body) `(defun ,name ,args - ,@(mapcar (lambda (q) `(2sql-query ,q)) body))) + ,@(mapcar (lambda (q) `(query ,q)) body))) diff --git a/packages.lisp b/packages.lisp @@ -2,11 +2,14 @@ (defpackage 2sql (:use :cl) - (:export #:2sql - #:2sql-string - #:2sql-query - #:2sql-lambda - #:define-2sql-function)) + (:export #:print-string + #:print-symbol + #:print-form + #:to-string + #:execute + #:query + #:qlambda + #:define-function)) (defpackage 2sql-macros (:use)