r11510: disconnect pooled session already removed from stack with

[clsql.git] / sql / operations.lisp

diff --git a/sql/operations.lisp b/sql/operations.lisp
index 5c0438473cbde8db77b8636556ae8a7b2caed25b..94ee20964b5c089ded361d10902eb30b890881c6 100644 (file)
--- a/sql/operations.lisp
+++ b/sql/operations.lisp
@@ -26,7 +26,7 @@
   `(progn
      (defun ,function ,@body)
      (let ((symbol (cadr (member :symbol ',definition-keys))))
-       (setf (gethash (if symbol (string-upcase symbol) ',function)
+       (setf (gethash (if symbol (symbol-name-default-case symbol) ',function)
                      *sql-op-table*)
             ',function))))
 
@@ -37,45 +37,57 @@
   (apply #'make-query args))
 
 (defsql sql-any (:symbol "any") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'any :components rest))
+  (make-instance 'sql-function-exp
+                :name 'any :args rest))
+
+(defsql sql-some (:symbol "some") (&rest rest)
+  (make-instance 'sql-function-exp
+                :name 'some :args rest))
 
 (defsql sql-all (:symbol "all") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'all :components rest))
+  (make-instance 'sql-function-exp
+                :name 'all :args rest))
 
 (defsql sql-not (:symbol "not") (&rest rest)
   (make-instance 'sql-value-exp
                 :modifier 'not :components rest))
 
 (defsql sql-union (:symbol "union") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'union :components rest))
+  (make-instance 'sql-set-exp
+                :operator 'union :sub-expressions rest))
 
 (defsql sql-intersect (:symbol "intersect") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'intersect :components rest))
+  (make-instance 'sql-set-exp
+                :operator 'intersect :sub-expressions rest))
 
-(defsql sql-minus (:symbol "minus") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'minus :components rest))
+(defsql sql-except (:symbol "except") (&rest rest) 
+  (make-instance 'sql-set-exp 
+                :operator 'except :sub-expressions rest))
 
-(defsql sql-group-by (:symbol "group-by") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'group-by :components rest))
+(defsql sql-minus (:symbol "minus") (&rest rest)
+  (make-instance 'sql-set-exp 
+                :operator 'minus :sub-expressions rest))
 
 (defsql sql-limit (:symbol "limit") (&rest rest)
-  (make-instance 'sql-value-exp
+  (make-instance 'sql-query-modifier-exp 
                 :modifier 'limit :components rest))
 
+(defsql sql-group-by (:symbol "group-by") (&rest rest)
+  (make-instance 'sql-query-modifier-exp 
+                :modifier '|group by| :components rest))
+
+(defsql sql-order-by (:symbol "order-by") (&rest rest)
+  (make-instance 'sql-query-modifier-exp 
+                :modifier '|order by| :components rest))
+
 (defsql sql-having (:symbol "having") (&rest rest)
-  (make-instance 'sql-value-exp
+  (make-instance 'sql-query-modifier-exp 
                 :modifier 'having :components rest))
 
 (defsql sql-null (:symbol "null") (&rest rest)
   (if rest
-      (make-instance 'sql-relational-exp :operator '|IS NULL| 
-                     :sub-expressions (list (car rest)))
+      (make-instance 'sql-relational-exp :operator 'is  
+                     :sub-expressions (list (car rest) nil))
       (make-instance 'sql-value-exp :components 'null)))
 
 (defsql sql-not-null (:symbol "not-null") ()
@@ -83,13 +95,12 @@
                 :components '|NOT NULL|))
 
 (defsql sql-exists (:symbol "exists") (&rest rest)
-  (make-instance 'sql-value-exp
-                :modifier 'exists :components rest))
+  (make-instance 'sql-function-exp
+                :name 'exists :args rest))
 
 (defsql sql-* (:symbol "*") (&rest rest)
   (if (zerop (length rest))
       (make-instance 'sql-ident :name '*)
-      ;(error 'clsql-sql-syntax-error :reason "'*' with arguments")))
       (make-instance 'sql-relational-exp :operator '* :sub-expressions rest)))
 
 (defsql sql-+ (:symbol "+") (&rest rest)
@@ -126,11 +137,27 @@
 
 (defsql sql-in (:symbol "in") (&rest rest)
   (make-instance 'sql-relational-exp
-                :operator 'in :sub-expressions rest))
+                 :operator 'in :sub-expressions rest))
+
+(defsql sql-concat-op (:symbol "concat-op") (&rest rest)
+  (make-instance 'sql-relational-exp
+                :operator '\|\| :sub-expressions rest))
 
-(defsql sql-|| (:symbol "||") (&rest rest)
-    (make-instance 'sql-relational-exp
-                :operator '|| :sub-expressions rest))
+(defsql sql-concat (:symbol "concat") (&rest rest)
+  (make-instance 'sql-function-exp
+                :name 'concat :args rest))
+
+(defsql sql-substr (:symbol "substr") (&rest rest)
+  (if (= (length rest) 3)
+      (make-instance 'sql-function-exp 
+                    :name 'substr :args rest)
+      (error 'sql-user-error :message "SUBSTR must have 3 arguments.")))
+
+(defsql sql-substring (:symbol "substring") (&rest rest)
+  (if (= (length rest) 3)
+      (make-instance 'sql-function-exp 
+                    :name 'substring :args rest)
+      (error 'sql-user-error :message "SUBSTRING must have 3 arguments.")))
 
 (defsql sql-is (:symbol "is") (&rest rest)
   (make-instance 'sql-relational-exp
@@ -193,9 +220,37 @@
        (make-instance 'sql-function-exp
                        :name (make-symbol (car args)) :args (cdr args)))
 
-;;(defsql sql-distinct (:symbol "distinct") (&rest rest)
-;;  nil)
+(defsql sql-between (:symbol "between") (&rest rest)
+  (if (= (length rest) 3)
+      (make-instance 'sql-between-exp :name 'between :args rest)
+      (error 'sql-user-error :message "BETWEEN must have 3 arguments.")))
 
-;;(defsql sql-between (:symbol "between") (&rest rest)
-;;  nil)
+(defsql sql-distinct (:symbol "distinct") (&rest rest)
+  (make-instance 'sql-query-modifier-exp :modifier 'distinct 
+                :components rest))
 
+(defsql sql-coalesce (:symbol "coalesce") (&rest rest)
+  (make-instance 'sql-function-exp
+                :name 'coalesce :args rest))
+
+(defsql sql-nvl (:symbol "nvl") (&rest rest)
+  (if (= (length rest) 2)      
+      (make-instance 'sql-function-exp
+                     :name 'coalesce :args rest)
+      (error 'sql-user-error :message "NVL accepts exactly 2 arguments.")))
+
+(defsql sql-userenv (:symbol "userenv") (&rest rest)
+  (make-instance 'sql-function-exp
+                :name 'userenv :args rest))
+
+(defsql sql-lower  (:symbol "lower") (&rest rest)
+  (if (= (length rest) 1)
+      (make-instance 'sql-function-exp
+                     :name 'lower :args rest)
+    (error 'sql-user-error :message "LOWER must have 1 argument.")))
+
+(defsql sql-upper  (:symbol "upper") (&rest rest)
+  (if (= (length rest) 1)
+      (make-instance 'sql-function-exp
+                     :name 'upper :args rest)
+    (error 'sql-user-error :message "UPPER must have 1 argument.")))