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)))))