1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
4 ;;;; Definition of SQL operations used with the symbolic SQL syntax.
6 ;;;; This file is part of CLSQL.
8 ;;;; CLSQL users are granted the rights to distribute and use this software
9 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
10 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
11 ;;;; *************************************************************************
13 (in-package #:clsql-sys)
15 ;; Keep a hashtable for mapping symbols to sql generator functions,
16 ;; for use by the bracketed reader syntax.
18 (defvar *sql-op-table* (make-hash-table :test #'equal))
21 ;; Define an SQL operation type.
23 (defmacro defsql (function definition-keys &body body)
25 (defun ,function ,@body)
26 (let ((symbol (cadr (member :symbol ',definition-keys))))
27 (setf (gethash (if symbol (symbol-name-default-case symbol) ',function)
34 (defsql sql-query (:symbol "select") (&rest args)
35 (apply #'make-query args))
37 (defsql sql-any (:symbol "any") (&rest rest)
38 (make-instance 'sql-function-exp
39 :name 'any :args rest))
41 (defsql sql-some (:symbol "some") (&rest rest)
42 (make-instance 'sql-function-exp
43 :name 'some :args rest))
45 (defsql sql-all (:symbol "all") (&rest rest)
46 (make-instance 'sql-function-exp
47 :name 'all :args rest))
49 (defsql sql-e-string (:symbol "E") (&rest rest)
50 (make-instance 'sql-escape-string-exp :string (first rest)))
52 (defsql sql-not (:symbol "not") (&rest rest)
53 (make-instance 'sql-value-exp
54 :modifier 'not :components rest))
56 (defsql sql-union (:symbol "union") (&rest rest)
57 (make-instance 'sql-set-exp
58 :operator 'union :sub-expressions rest))
60 (defsql sql-intersect (:symbol "intersect") (&rest rest)
61 (make-instance 'sql-set-exp
62 :operator 'intersect :sub-expressions rest))
64 (defsql sql-except (:symbol "except") (&rest rest)
65 (make-instance 'sql-set-exp
66 :operator 'except :sub-expressions rest))
68 (defsql sql-minus (:symbol "minus") (&rest rest)
69 (make-instance 'sql-set-exp
70 :operator 'minus :sub-expressions rest))
72 (defsql sql-limit (:symbol "limit") (&rest rest)
73 (make-instance 'sql-query-modifier-exp
74 :modifier 'limit :components rest))
76 (defsql sql-group-by (:symbol "group-by") (&rest rest)
77 (make-instance 'sql-query-modifier-exp
78 :modifier '|GROUP BY| :components rest))
80 (defsql sql-order-by (:symbol "order-by") (&rest rest)
81 (make-instance 'sql-query-modifier-exp
82 :modifier '|ORDER BY| :components rest))
84 (defsql sql-having (:symbol "having") (&rest rest)
85 (make-instance 'sql-query-modifier-exp
86 :modifier 'having :components rest))
88 (defsql sql-null (:symbol "null") (&optional not-null-thing)
90 (make-instance 'sql-relational-exp :operator 'is
91 :sub-expressions (list not-null-thing nil))
92 (make-instance 'sql-value-exp :components 'null)))
94 (defsql sql-not-null (:symbol "not-null") (&optional not-null-thing)
99 :sub-expressions (list not-null-thing
100 (sql-expression :string "NOT NULL")))
101 (sql-expression :string "NOT NULL")))
103 (defsql sql-exists (:symbol "exists") (&rest rest)
104 (make-instance 'sql-function-exp
105 :name 'exists :args rest))
107 (defsql sql-* (:symbol "*") (&rest rest)
108 (if (zerop (length rest))
109 (make-instance 'sql-ident :name '*)
110 (make-instance 'sql-relational-exp :operator '* :sub-expressions rest)))
112 (defsql sql-+ (:symbol "+") (&rest rest)
114 (make-instance 'sql-relational-exp
115 :operator '+ :sub-expressions rest)
116 (make-instance 'sql-value-exp :modifier '+ :components rest)))
118 (defsql sql-/ (:symbol "/") (&rest rest)
119 (make-instance 'sql-relational-exp
120 :operator '/ :sub-expressions rest))
122 (defsql sql-- (:symbol "-") (&rest rest)
124 (make-instance 'sql-relational-exp
125 :operator '- :sub-expressions rest)
126 (make-instance 'sql-value-exp :modifier '- :components rest)))
128 (defsql sql-like (:symbol "like") (&rest rest)
129 (make-instance 'sql-relational-exp
130 :operator 'like :sub-expressions rest))
132 (defsql sql-uplike (:symbol "uplike") (&rest rest)
133 (make-instance 'sql-upcase-like
134 :sub-expressions rest))
136 (defsql sql-and (:symbol "and") (&rest rest)
137 (make-instance 'sql-relational-exp
138 :operator 'and :sub-expressions rest))
140 (defsql sql-or (:symbol "or") (&rest rest)
141 (make-instance 'sql-relational-exp
142 :operator 'or :sub-expressions rest))
144 (defsql sql-in (:symbol "in") (&rest rest)
145 (make-instance 'sql-relational-exp
146 :operator 'in :sub-expressions rest))
148 (defsql sql-concat-op (:symbol "concat-op") (&rest rest)
149 (make-instance 'sql-relational-exp
150 :operator '\|\| :sub-expressions rest))
152 (defsql sql-concat (:symbol "concat") (&rest rest)
153 (make-instance 'sql-function-exp
154 :name 'concat :args rest))
156 (defsql sql-substr (:symbol "substr") (&rest rest)
157 (if (= (length rest) 3)
158 (make-instance 'sql-function-exp
159 :name 'substr :args rest)
160 (error 'sql-user-error :message "SUBSTR must have 3 arguments.")))
162 (defsql sql-substring (:symbol "substring") (&rest rest)
163 (if (= (length rest) 3)
164 (make-instance 'sql-function-exp
165 :name 'substring :args rest)
166 (error 'sql-user-error :message "SUBSTRING must have 3 arguments.")))
168 (defsql sql-is (:symbol "is") (&rest rest)
169 (make-instance 'sql-relational-exp
170 :operator 'is :sub-expressions rest))
172 (defsql sql-= (:symbol "=") (&rest rest)
173 (make-instance 'sql-relational-exp
174 :operator '= :sub-expressions rest))
176 (defsql sql-== (:symbol "==") (&rest rest)
177 (make-instance 'sql-assignment-exp
178 :operator '= :sub-expressions rest))
180 (defsql sql-< (:symbol "<") (&rest rest)
181 (make-instance 'sql-relational-exp
182 :operator '< :sub-expressions rest))
185 (defsql sql-> (:symbol ">") (&rest rest)
186 (make-instance 'sql-relational-exp
187 :operator '> :sub-expressions rest))
189 (defsql sql-<> (:symbol "<>") (&rest rest)
190 (make-instance 'sql-relational-exp
191 :operator '<> :sub-expressions rest))
193 (defsql sql->= (:symbol ">=") (&rest rest)
194 (make-instance 'sql-relational-exp
195 :operator '>= :sub-expressions rest))
197 (defsql sql-<= (:symbol "<=") (&rest rest)
198 (make-instance 'sql-relational-exp
199 :operator '<= :sub-expressions rest))
201 (defsql sql-count (:symbol "count") (&rest rest)
202 (make-instance 'sql-function-exp
203 :name 'count :args rest))
205 (defsql sql-max (:symbol "max") (&rest rest)
206 (make-instance 'sql-function-exp
207 :name 'max :args rest))
209 (defsql sql-min (:symbol "min") (&rest rest)
210 (make-instance 'sql-function-exp
211 :name 'min :args rest))
213 (defsql sql-avg (:symbol "avg") (&rest rest)
214 (make-instance 'sql-function-exp
215 :name 'avg :args rest))
217 (defsql sql-sum (:symbol "sum") (&rest rest)
218 (make-instance 'sql-function-exp
219 :name 'sum :args rest))
221 (defsql sql-the (:symbol "the") (&rest rest)
222 (make-instance 'sql-typecast-exp
223 :modifier (first rest) :components (second rest)))
225 (defsql sql-function (:symbol "function") (&rest args)
226 (make-instance 'sql-function-exp
227 :name (make-symbol (car args)) :args (cdr args)))
229 (defsql sql-between (:symbol "between") (&rest rest)
230 (if (= (length rest) 3)
231 (make-instance 'sql-between-exp :name 'between :args rest)
232 (error 'sql-user-error :message "BETWEEN must have 3 arguments.")))
234 (defsql sql-distinct (:symbol "distinct") (&rest rest)
235 (make-instance 'sql-query-modifier-exp :modifier 'distinct
238 (defsql sql-coalesce (:symbol "coalesce") (&rest rest)
239 (make-instance 'sql-function-exp
240 :name 'coalesce :args rest))
242 (defsql sql-nvl (:symbol "nvl") (&rest rest)
243 (if (= (length rest) 2)
244 (make-instance 'sql-function-exp
245 :name 'coalesce :args rest)
246 (error 'sql-user-error :message "NVL accepts exactly 2 arguments.")))
248 (defsql sql-userenv (:symbol "userenv") (&rest rest)
249 (make-instance 'sql-function-exp
250 :name 'userenv :args rest))
252 (defsql sql-lower (:symbol "lower") (&rest rest)
253 (if (= (length rest) 1)
254 (make-instance 'sql-function-exp
255 :name 'lower :args rest)
256 (error 'sql-user-error :message "LOWER must have 1 argument.")))
258 (defsql sql-upper (:symbol "upper") (&rest rest)
259 (if (= (length rest) 1)
260 (make-instance 'sql-function-exp
261 :name 'upper :args rest)
262 (error 'sql-user-error :message "UPPER must have 1 argument.")))