On 10077 day of my life Marijn Haverbeke wrote:
... a patch?
Comment string may require full rewriting.
diff -rN -u old-postmodern/postmodern/package.lisp new-postmodern/postmodern/package.lisp --- old-postmodern/postmodern/package.lisp 2008-01-07 20:38:27.000000000 +0600 +++ new-postmodern/postmodern/package.lisp 2008-01-07 20:38:27.000000000 +0600 @@ -25,6 +25,7 @@ #:smallint #:bigint #:numeric #:real #:double-precision #:bytea #:text #:varchar #:*escape-sql-names-p* #:sql-escape-string + #:def-infix-ops
;; Condition type from cl-postgres #:database-error #:database-error-message #:database-error-code diff -rN -u old-postmodern/s-sql/s-sql.lisp new-postmodern/s-sql/s-sql.lisp --- old-postmodern/s-sql/s-sql.lisp 2008-01-07 20:38:27.000000000 +0600 +++ new-postmodern/s-sql/s-sql.lisp 2008-01-07 20:38:27.000000000 +0600 @@ -16,6 +16,7 @@ #:to-sql-name #:sql-ize #:*escape-sql-names-p* + #:def-infix-ops #:sql #:sql-compile #:enable-s-sql-syntax)) @@ -373,21 +374,58 @@ (destructuring-bind ,arglist ,args-name ,@body))))
-(defun expand-infix-op (operator allow-unary args) - (if (cdr args) - `("(" ,@(sql-expand-list args (strcat " " operator " ")) ")") - (if allow-unary - (sql-expand (first args)) - (error "SQL operator ~A takes at least two arguments." operator)))) - -(defmacro def-infix-ops (allow-unary &rest ops) +(defun expand-infix-op (operator class args) + (declare (type (member t :both nil) class)) + (cond + ((cdr args) + `("(" ,@(sql-expand-list args (strcat " " operator " ")) ")")) + ((eq class t) + (sql-expand (first args))) + ((eq class :both) + `(,operator "(" ,@(sql-expand (first args)) ")")) + (t + (error "SQL operator ~A takes at least two arguments." operator)))) + +(defmacro def-infix-ops (class &rest ops) + (declare (type (member t :both nil) class)) + "Define infix operators. +CLASS may be either T, :BOTH or NIL. + + 1. T. S-SQL operators may be both binary and unary, but unary form + is equivalent to the only argument itself (e.g. + (:AND condition) => "condition"). + + 2. :BOTH. S-SQL operators may be both binary and unary, but unlike + T, operator is kept before the argument in unary form. Example + is PosgreSQL's ?| operator: + (def-infix-ops :both :?\|) + (:?\| a) => "?|(a)" + (:?\| a b) => "a ?| b". + + 3. NIL. Operator is binary only. + +OPS is a list of operator designators. There are two kinds of +operator designators: + + 1. A keyword. Downcased symbol value of the keword is used as SQL + name of operator. + + 2. Two-element list: (KEYWORD STRING). String is used as SQL name + of operator, and KEYWORD is S-SQL name of operator. + Example: (:concat "||")." `(progn ,@(mapcar (lambda (op) - `(defmethod expand-sql-op ((op (eql ,op)) args) - (expand-infix-op ,(string-downcase (symbol-name op)) ,allow-unary args))) + (when (keywordp op) + (setf op (list op (string-downcase (symbol-name op))))) + (let ((kwd (first op)) + (txt (second op))) + `(defmethod expand-sql-op ((op (eql ,kwd)) args) + (expand-infix-op ,txt ,class args)))) ops))) -(def-infix-ops t :+ :* :& :||| :and :or :union) -(def-infix-ops nil := :/ :!= :< :> :<= :>= :^ :intersect :except :~* :!~ :!~* :like :ilike) + +(def-infix-ops t :+ :* :& :||| :and :or :union :|| (:concat "||")) +(def-infix-ops nil := :/ :!= :< :> :<= :>= :^ :intersect :except :~* :!~ :!~* + :like :ilike :&& :% :# :<< :>>)
(def-sql-op :- (first &rest rest) (if rest