From 9fde24d7b5617d58b58ff0ada04f8adea39ca30d Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <moritz-gitorious@twoticketsplease.de>
Date: Sun, 6 Mar 2011 22:03:02 +0100
Subject: [PATCH] move `insert-clause' into ssql translator engine so it can be
 specialized

---
 ssql.scm | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/ssql.scm b/ssql.scm
index 06cc717..bab35f5 100644
--- a/ssql.scm
+++ b/ssql.scm
@@ -9,6 +9,13 @@
 (begin-for-syntax
  (use srfi-1 srfi-13))
 
+(define (before? x y lst)
+  (let loop ((lst lst))
+    (or (null? lst)
+        (eq? x (car lst))
+        (and (not (eq? y (car lst)))
+             (loop (cdr lst))))))
+
 (define-syntax define-operators
   (ir-macro-transformer
    (lambda (x i c)
@@ -111,7 +118,15 @@
                 (let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply)))
                   (if handler
                       (self handler ssql)
-                      (error "unknown datatype" ssql))))))
+                      (error "unknown datatype" ssql))))
+
+               ((insert-clause clause ssql)
+                (let ((order (self 'clauses-order)))
+                  (let loop ((ssql ssql))
+                    (cond ((null? ssql) (list clause))
+                          ((before? (car clause) (caar ssql) order)
+                           (cons clause ssql))
+                          (else (cons (car ssql) (loop (cdr ssql))))))))))
 
 (define-operators *ansi-translator*
   (select prefix)
@@ -245,21 +260,6 @@
 	    (append (loop #f tables head) (loop #f tables tail)))
 	   (_ tables))))
 
-(define (before? x y lst)
-  (let loop ((lst lst))
-    (or (null? lst)
-        (eq? x (car lst))
-        (and (not (eq? y (car lst)))
-             (loop (cdr lst))))))
-
-(define (insert-clause engine clause ssql)
-  (let ((order (engine 'clauses-order)))
-    (let loop ((ssql ssql))
-      (cond ((null? ssql) (list clause))
-            ((before? (car clause) (caar ssql) order)
-             (cons clause ssql))
-            (else (cons (car ssql) (loop (cdr ssql))))))))
-
 (define (ssql-compose connection ssql clauses)
   (call-with-sql-engine connection
     (lambda (engine)
@@ -268,7 +268,7 @@
                           (let ((target (alist-ref (car clause) ssql)))
                             (if target
                                 (alist-update! (car clause) (append target (cdr clause)) ssql)
-                                (insert-clause engine clause ssql))))
+                                (engine 'insert-clause clause ssql))))
                         (cdr ssql)
                         clauses)))))