cl-2sql

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

big rename

Diffstat:
M
core.lisp
 | 
42
++++++++++++++++++++++++------------------
M
packages.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)