cl-2sql

commit d15ecde1a4b1fcb213d30ebbadda38e324f74c35
parent fcc0be4d35710dc0c49bde833ff23b471e671d09
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 31 Jul 2011 15:17:39 +0200

add lforms and implement 2sql-lambda

Diffstat:
M
core.lisp
 | 
29
+++++++++++++++++++++++------
M
macros.lisp
 | 
3
+++
M
packages.lisp
 | 
2
+-

3 files changed, 27 insertions(+), 7 deletions(-)
diff --git a/core.lisp b/core.lisp
@@ -10,7 +10,7 @@
           (split-sequence:split-sequence #\. (symbol-name x))))
 
 (defun 2sql (form stream &optional (princ-symbol 'princ-symbol))
-  (let ((lvars nil))
+  (let (lvars lforms)
     (labels ((rec (x)
                (if (atom x)
                    (etypecase x
@@ -22,6 +22,9 @@
                      (:lvar
                       (push (cdr x) lvars)
                       (format stream ":~d" (length lvars)))
+                     (:lform
+                      (push (cdr x) lforms)
+                      (princ "~a" stream))
                      (:par
                        (write-char #\( stream)
                        (rec (cons :lst (cons nil (cdr x))))
@@ -34,12 +37,26 @@
                                (princ (or sep " ") stream))
                              (rec x)
                              (incf i))))))))
-      (rec form)
-      lvars)))
+      (rec form))
+    (values (nreverse lvars) (nreverse lforms))))
 
 (defun 2sql-string (form &optional (princ-symbol 'princ-symbol))
-  (let (lvars)
+  (let (lvars lforms)
     (values
      (with-output-to-string (s)
-       (setq lvars (2sql (macroexpand form) s princ-symbol)))
-     lvars)))
+       (multiple-value-setq (lvars lforms)
+         (2sql (macroexpand form) s princ-symbol)))
+     lvars
+     lforms)))
+
+(defmacro 2sql-lambda (form) ;; TODO lforms
+  `(lambda ()
+     , (flet ((paste (x)
+                (when x
+                  `(list ,@x))))
+         (multiple-value-bind (str lvars lforms) (2sql-string form)
+           `(values
+             ,str
+             ,(paste (mapcar (lambda (x) (car x)) lvars))
+             ,(paste (mapcar #'cdr lvars))
+             ,(paste (mapcar (lambda (x) `(funcall (lambda () ,@x))) lforms)))))))
diff --git a/macros.lisp b/macros.lisp
@@ -179,3 +179,6 @@
 
 ;; (defsyntax type (&body body)
 ;;   `(:type ,@body))
+
+(defsyntax lform (lform)
+  `(:lform ,lform))
diff --git a/packages.lisp b/packages.lisp
@@ -2,7 +2,7 @@
 
 (defpackage 2sql
   (:use :cl)
-  (:export #:2sql #:2sql-string))
+  (:export #:2sql #:2sql-string #:2sql-lambda))
 
 (defpackage 2sql-macros
   (:use)