X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Foperations.lisp;h=b4d3eab8db559a4848640a754e8e4882e36f093b;hp=b552e9855721aa3de37b63d9e6c86f3a4e1b7a4e;hb=e622ee6f4bf2b9fe81af59d566e651c983a4833b;hpb=a4449b6f1b9fb2471da255fc506bcad6f8feb220

diff --git a/sql/operations.lisp b/sql/operations.lisp
index b552e98..b4d3eab 100644
--- a/sql/operations.lisp
+++ b/sql/operations.lisp
@@ -1,18 +1,19 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; $Id: $
-;;;; ======================================================================
+;;;; *************************************************************************
 ;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; $Id$
 ;;;;
 ;;;; Definition of SQL operations used with the symbolic SQL syntax. 
 ;;;;
-;;;; ======================================================================
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
 
 (in-package #:clsql-sys)
 
-
 ;; Keep a hashtable for mapping symbols to sql generator functions,
 ;; for use by the bracketed reader syntax.
 
@@ -25,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))))
 
@@ -36,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 'except :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") ()
@@ -82,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)
@@ -125,11 +137,17 @@
 
 (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 (:symbol "concat") (&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-substr (:symbol "substr") (&rest rest)
+  (if (= (length rest) 3)
+      (make-instance 'sql-function-exp 
+		     :name 'substring :args rest)
+      (error 'sql-user-error :message "SUBSTR must have 3 arguments.")))
 
 (defsql sql-is (:symbol "is") (&rest rest)
   (make-instance 'sql-relational-exp
@@ -192,9 +210,19 @@
 	(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)
+  (make-instance 'sql-function-exp
+		 :name 'coalesce :args rest))