move `insert-clause' into ssql translator engine so it can be specialized

master
Moritz Heidkamp 14 years ago
parent 7c27be9b96
commit 9fde24d7b5

@ -9,6 +9,13 @@
(begin-for-syntax (begin-for-syntax
(use srfi-1 srfi-13)) (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 (define-syntax define-operators
(ir-macro-transformer (ir-macro-transformer
(lambda (x i c) (lambda (x i c)
@ -111,7 +118,15 @@
(let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply))) (let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply)))
(if handler (if handler
(self handler ssql) (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* (define-operators *ansi-translator*
(select prefix) (select prefix)
@ -245,21 +260,6 @@
(append (loop #f tables head) (loop #f tables tail))) (append (loop #f tables head) (loop #f tables tail)))
(_ tables)))) (_ 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) (define (ssql-compose connection ssql clauses)
(call-with-sql-engine connection (call-with-sql-engine connection
(lambda (engine) (lambda (engine)
@ -268,7 +268,7 @@
(let ((target (alist-ref (car clause) ssql))) (let ((target (alist-ref (car clause) ssql)))
(if target (if target
(alist-update! (car clause) (append target (cdr clause)) ssql) (alist-update! (car clause) (append target (cdr clause)) ssql)
(insert-clause engine clause ssql)))) (engine 'insert-clause clause ssql))))
(cdr ssql) (cdr ssql)
clauses))))) clauses)))))

Loading…
Cancel
Save