X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=28915b5e55c6e5d5960348efda8d70454429e9b1;hb=6828cb461404126aa0c334fe2b669d435304f73e;hp=304cb3bfa5f9f70f56cad3b90ec70ecfecdb4c6c;hpb=9c0cfd2ef1ee5b236fa870061127052689dd581a;p=clsql.git diff --git a/sql/expressions.lisp b/sql/expressions.lisp index 304cb3b..28915b5 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -242,35 +242,34 @@ ;; should do arity checking of subexpressions (defmethod output-sql ((expr sql-relational-exp) database) - (with-slots (operator sub-expressions) - expr - (when sub-expressions - (let (has-written) - ;; we do this as two runs so as not to emit confusing superflous parentheses - ;; The first loop renders all the child outputs so that we can skip anding with - ;; empty output (which causes sql errors) - ;; the next loop simply emits each sub-expression with the appropriate number of - ;; parens and operators - (let ((str-subs (loop for sub in sub-expressions - for str-sub = (string-trim '(#\space #\newline #\return #\tab #\no-break_space) - (with-output-to-string (*sql-stream*) - (output-sql sub database))) - when (and str-sub (> (length str-sub) 0)) - collect str-sub - ))) - (loop for str-sub in str-subs - do - (progn - (when (and (not has-written) - (> (length str-subs) 1)) - (write-char #\( *sql-stream*)) - (when has-written + (with-slots (operator sub-expressions) expr + ;; we do this as two runs so as not to emit confusing superflous parentheses + ;; The first loop renders all the child outputs so that we can skip anding with + ;; empty output (which causes sql errors) + ;; the next loop simply emits each sub-expression with the appropriate number of + ;; parens and operators + (flet ((trim (sub) + (string-trim '(#\space #\newline #\return #\tab #\no-break_space) + (with-output-to-string (*sql-stream*) + (output-sql sub database))))) + (let ((str-subs (loop for sub in sub-expressions + for str-sub = (trim sub) + when (and str-sub (> (length str-sub) 0)) + collect str-sub))) + (case (length str-subs) + (0 nil) + (1 (write-string (first str-subs) *sql-stream*)) + (t + (write-char #\( *sql-stream*) + (write-string (first str-subs) *sql-stream*) + (loop for str-sub in (rest str-subs) + do + (write-char #\Space *sql-stream*) + (output-sql operator database) (write-char #\Space *sql-stream*) - (output-sql operator database)) - (write-string str-sub *sql-stream*) - (setf has-written T))) - (when (and has-written (> (length str-subs) 1)) - (write-char #\) *sql-stream*)))))) + (write-string str-sub *sql-stream*)) + (write-char #\) *sql-stream*)) + )))) t) (defclass sql-array-exp (sql-relational-exp)