1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
6 ;;;; Definition of SQL operations used with the symbolic SQL syntax.
8 ;;;; This file is part of CLSQL.
10 ;;;; CLSQL users are granted the rights to distribute and use this software
11 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
12 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
13 ;;;; *************************************************************************
15 (in-package #:clsql-sys
)
17 ;; Keep a hashtable for mapping symbols to sql generator functions,
18 ;; for use by the bracketed reader syntax.
20 (defvar *sql-op-table
* (make-hash-table :test
#'equal
))
23 ;; Define an SQL operation type.
25 (defmacro defsql
(function definition-keys
&body body
)
27 (defun ,function
,@body
)
28 (let ((symbol (cadr (member :symbol
',definition-keys
))))
29 (setf (gethash (if symbol
(symbol-name-default-case symbol
) ',function
)
36 (defsql sql-query
(:symbol
"select") (&rest args
)
37 (apply #'make-query args
))
39 (defsql sql-any
(:symbol
"any") (&rest rest
)
40 (make-instance 'sql-function-exp
41 :name
'any
:args rest
))
43 (defsql sql-some
(:symbol
"some") (&rest rest
)
44 (make-instance 'sql-function-exp
45 :name
'some
:args rest
))
47 (defsql sql-all
(:symbol
"all") (&rest rest
)
48 (make-instance 'sql-function-exp
49 :name
'all
:args rest
))
51 (defsql sql-not
(:symbol
"not") (&rest rest
)
52 (make-instance 'sql-value-exp
53 :modifier
'not
:components rest
))
55 (defsql sql-union
(:symbol
"union") (&rest rest
)
56 (make-instance 'sql-set-exp
57 :operator
'union
:sub-expressions rest
))
59 (defsql sql-intersect
(:symbol
"intersect") (&rest rest
)
60 (make-instance 'sql-set-exp
61 :operator
'intersect
:sub-expressions rest
))
63 (defsql sql-except
(:symbol
"except") (&rest rest
)
64 (make-instance 'sql-set-exp
65 :operator
'except
:sub-expressions rest
))
67 (defsql sql-minus
(:symbol
"minus") (&rest rest
)
68 (make-instance 'sql-set-exp
69 :operator
'minus
:sub-expressions rest
))
71 (defsql sql-limit
(:symbol
"limit") (&rest rest
)
72 (make-instance 'sql-query-modifier-exp
73 :modifier
'limit
:components rest
))
75 (defsql sql-group-by
(:symbol
"group-by") (&rest rest
)
76 (make-instance 'sql-query-modifier-exp
77 :modifier
'|group by|
:components rest
))
79 (defsql sql-order-by
(:symbol
"order-by") (&rest rest
)
80 (make-instance 'sql-query-modifier-exp
81 :modifier
'|order by|
:components rest
))
83 (defsql sql-having
(:symbol
"having") (&rest rest
)
84 (make-instance 'sql-query-modifier-exp
85 :modifier
'having
:components rest
))
87 (defsql sql-null
(:symbol
"null") (&rest rest
)
89 (make-instance 'sql-relational-exp
:operator
'is
90 :sub-expressions
(list (car rest
) nil
))
91 (make-instance 'sql-value-exp
:components
'null
)))
93 (defsql sql-not-null
(:symbol
"not-null") ()
94 (make-instance 'sql-value-exp
95 :components
'|NOT NULL|
))
97 (defsql sql-exists
(:symbol
"exists") (&rest rest
)
98 (make-instance 'sql-function-exp
99 :name
'exists
:args rest
))
101 (defsql sql-
* (:symbol
"*") (&rest rest
)
102 (if (zerop (length rest
))
103 (make-instance 'sql-ident
:name
'*)
104 (make-instance 'sql-relational-exp
:operator
'* :sub-expressions rest
)))
106 (defsql sql-
+ (:symbol
"+") (&rest rest
)
108 (make-instance 'sql-relational-exp
109 :operator
'+ :sub-expressions rest
)
110 (make-instance 'sql-value-exp
:modifier
'+ :components rest
)))
112 (defsql sql-
/ (:symbol
"/") (&rest rest
)
113 (make-instance 'sql-relational-exp
114 :operator
'/ :sub-expressions rest
))
116 (defsql sql--
(:symbol
"-") (&rest rest
)
118 (make-instance 'sql-relational-exp
119 :operator
'-
:sub-expressions rest
)
120 (make-instance 'sql-value-exp
:modifier
'-
:components rest
)))
122 (defsql sql-like
(:symbol
"like") (&rest rest
)
123 (make-instance 'sql-relational-exp
124 :operator
'like
:sub-expressions rest
))
126 (defsql sql-uplike
(:symbol
"uplike") (&rest rest
)
127 (make-instance 'sql-upcase-like
128 :sub-expressions rest
))
130 (defsql sql-and
(:symbol
"and") (&rest rest
)
131 (make-instance 'sql-relational-exp
132 :operator
'and
:sub-expressions rest
))
134 (defsql sql-or
(:symbol
"or") (&rest rest
)
135 (make-instance 'sql-relational-exp
136 :operator
'or
:sub-expressions rest
))
138 (defsql sql-in
(:symbol
"in") (&rest rest
)
139 (make-instance 'sql-relational-exp
140 :operator
'in
:sub-expressions rest
))
142 (defsql sql-concat-op
(:symbol
"concat-op") (&rest rest
)
143 (make-instance 'sql-relational-exp
144 :operator
'\|\|
:sub-expressions rest
))
146 (defsql sql-concat
(:symbol
"concat") (&rest rest
)
147 (make-instance 'sql-function-exp
148 :name
'concat
:args rest
))
150 (defsql sql-substr
(:symbol
"substr") (&rest rest
)
151 (if (= (length rest
) 3)
152 (make-instance 'sql-function-exp
153 :name
'substr
:args rest
)
154 (error 'sql-user-error
:message
"SUBSTR must have 3 arguments.")))
156 (defsql sql-substring
(:symbol
"substring") (&rest rest
)
157 (if (= (length rest
) 3)
158 (make-instance 'sql-function-exp
159 :name
'substring
:args rest
)
160 (error 'sql-user-error
:message
"SUBSTRING must have 3 arguments.")))
162 (defsql sql-is
(:symbol
"is") (&rest rest
)
163 (make-instance 'sql-relational-exp
164 :operator
'is
:sub-expressions rest
))
166 (defsql sql-
= (:symbol
"=") (&rest rest
)
167 (make-instance 'sql-relational-exp
168 :operator
'= :sub-expressions rest
))
170 (defsql sql-
== (:symbol
"==") (&rest rest
)
171 (make-instance 'sql-assignment-exp
172 :operator
'= :sub-expressions rest
))
174 (defsql sql-
< (:symbol
"<") (&rest rest
)
175 (make-instance 'sql-relational-exp
176 :operator
'< :sub-expressions rest
))
179 (defsql sql-
> (:symbol
">") (&rest rest
)
180 (make-instance 'sql-relational-exp
181 :operator
'> :sub-expressions rest
))
183 (defsql sql-
<> (:symbol
"<>") (&rest rest
)
184 (make-instance 'sql-relational-exp
185 :operator
'<> :sub-expressions rest
))
187 (defsql sql-
>= (:symbol
">=") (&rest rest
)
188 (make-instance 'sql-relational-exp
189 :operator
'>= :sub-expressions rest
))
191 (defsql sql-
<= (:symbol
"<=") (&rest rest
)
192 (make-instance 'sql-relational-exp
193 :operator
'<= :sub-expressions rest
))
195 (defsql sql-count
(:symbol
"count") (&rest rest
)
196 (make-instance 'sql-function-exp
197 :name
'count
:args rest
))
199 (defsql sql-max
(:symbol
"max") (&rest rest
)
200 (make-instance 'sql-function-exp
201 :name
'max
:args rest
))
203 (defsql sql-min
(:symbol
"min") (&rest rest
)
204 (make-instance 'sql-function-exp
205 :name
'min
:args rest
))
207 (defsql sql-avg
(:symbol
"avg") (&rest rest
)
208 (make-instance 'sql-function-exp
209 :name
'avg
:args rest
))
211 (defsql sql-sum
(:symbol
"sum") (&rest rest
)
212 (make-instance 'sql-function-exp
213 :name
'sum
:args rest
))
215 (defsql sql-the
(:symbol
"the") (&rest rest
)
216 (make-instance 'sql-typecast-exp
217 :modifier
(first rest
) :components
(second rest
)))
219 (defsql sql-function
(:symbol
"function") (&rest args
)
220 (make-instance 'sql-function-exp
221 :name
(make-symbol (car args
)) :args
(cdr args
)))
223 (defsql sql-between
(:symbol
"between") (&rest rest
)
224 (if (= (length rest
) 3)
225 (make-instance 'sql-between-exp
:name
'between
:args rest
)
226 (error 'sql-user-error
:message
"BETWEEN must have 3 arguments.")))
228 (defsql sql-distinct
(:symbol
"distinct") (&rest rest
)
229 (make-instance 'sql-query-modifier-exp
:modifier
'distinct
232 (defsql sql-coalesce
(:symbol
"coalesce") (&rest rest
)
233 (make-instance 'sql-function-exp
234 :name
'coalesce
:args rest
))
236 (defsql sql-nvl
(:symbol
"nvl") (&rest rest
)
237 (if (= (length rest
) 2)
238 (make-instance 'sql-function-exp
239 :name
'coalesce
:args rest
)
240 (error 'sql-user-error
:message
"NVL accepts exactly 2 arguments.")))
242 (defsql sql-userenv
(:symbol
"userenv") (&rest rest
)
243 (make-instance 'sql-function-exp
244 :name
'userenv
:args rest
))
246 (defsql sql-lower
(:symbol
"lower") (&rest rest
)
247 (if (= (length rest
) 1)
248 (make-instance 'sql-function-exp
249 :name
'lower
:args rest
)
250 (error 'sql-user-error
:message
"LOWER must have 1 argument.")))
252 (defsql sql-upper
(:symbol
"upper") (&rest rest
)
253 (if (= (length rest
) 1)
254 (make-instance 'sql-function-exp
255 :name
'upper
:args rest
)
256 (error 'sql-user-error
:message
"UPPER must have 1 argument.")))