1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
4 ;;;; ======================================================================
6 ;;;; Description ==========================================================
7 ;;;; ======================================================================
9 ;;;; Definition of SQL operations used with the symbolic SQL syntax.
11 ;;;; ======================================================================
13 (in-package #:clsql-sys)
16 ;; Keep a hashtable for mapping symbols to sql generator functions,
17 ;; for use by the bracketed reader syntax.
19 (defvar *sql-op-table* (make-hash-table :test #'equal))
22 ;; Define an SQL operation type.
24 (defmacro defsql (function definition-keys &body body)
26 (defun ,function ,@body)
27 (let ((symbol (cadr (member :symbol ',definition-keys))))
28 (setf (gethash (if symbol (string-upcase symbol) ',function)
35 (defsql sql-query (:symbol "select") (&rest args)
36 (apply #'make-query args))
38 (defsql sql-any (:symbol "any") (&rest rest)
39 (make-instance 'sql-value-exp
40 :modifier 'any :components rest))
42 (defsql sql-all (:symbol "all") (&rest rest)
43 (make-instance 'sql-value-exp
44 :modifier 'all :components rest))
46 (defsql sql-not (:symbol "not") (&rest rest)
47 (make-instance 'sql-value-exp
48 :modifier 'not :components rest))
50 (defsql sql-union (:symbol "union") (&rest rest)
51 (make-instance 'sql-value-exp
52 :modifier 'union :components rest))
54 (defsql sql-intersect (:symbol "intersect") (&rest rest)
55 (make-instance 'sql-value-exp
56 :modifier 'intersect :components rest))
58 (defsql sql-minus (:symbol "minus") (&rest rest)
59 (make-instance 'sql-value-exp
60 :modifier 'minus :components rest))
62 (defsql sql-group-by (:symbol "group-by") (&rest rest)
63 (make-instance 'sql-value-exp
64 :modifier 'group-by :components rest))
66 (defsql sql-limit (:symbol "limit") (&rest rest)
67 (make-instance 'sql-value-exp
68 :modifier 'limit :components rest))
70 (defsql sql-having (:symbol "having") (&rest rest)
71 (make-instance 'sql-value-exp
72 :modifier 'having :components rest))
74 (defsql sql-null (:symbol "null") (&rest rest)
76 (make-instance 'sql-relational-exp :operator '|IS NULL|
77 :sub-expressions (list (car rest)))
78 (make-instance 'sql-value-exp :components 'null)))
80 (defsql sql-not-null (:symbol "not-null") ()
81 (make-instance 'sql-value-exp
82 :components '|NOT NULL|))
84 (defsql sql-exists (:symbol "exists") (&rest rest)
85 (make-instance 'sql-value-exp
86 :modifier 'exists :components rest))
88 (defsql sql-* (:symbol "*") (&rest rest)
89 (if (zerop (length rest))
90 (make-instance 'sql-ident :name '*)
91 ;(error 'clsql-sql-syntax-error :reason "'*' with arguments")))
92 (make-instance 'sql-relational-exp :operator '* :sub-expressions rest)))
94 (defsql sql-+ (:symbol "+") (&rest rest)
96 (make-instance 'sql-relational-exp
97 :operator '+ :sub-expressions rest)
98 (make-instance 'sql-value-exp :modifier '+ :components rest)))
100 (defsql sql-/ (:symbol "/") (&rest rest)
101 (make-instance 'sql-relational-exp
102 :operator '/ :sub-expressions rest))
104 (defsql sql-- (:symbol "-") (&rest rest)
106 (make-instance 'sql-relational-exp
107 :operator '- :sub-expressions rest)
108 (make-instance 'sql-value-exp :modifier '- :components rest)))
110 (defsql sql-like (:symbol "like") (&rest rest)
111 (make-instance 'sql-relational-exp
112 :operator 'like :sub-expressions rest))
114 (defsql sql-uplike (:symbol "uplike") (&rest rest)
115 (make-instance 'sql-upcase-like
116 :sub-expressions rest))
118 (defsql sql-and (:symbol "and") (&rest rest)
119 (make-instance 'sql-relational-exp
120 :operator 'and :sub-expressions rest))
122 (defsql sql-or (:symbol "or") (&rest rest)
123 (make-instance 'sql-relational-exp
124 :operator 'or :sub-expressions rest))
126 (defsql sql-in (:symbol "in") (&rest rest)
127 (make-instance 'sql-relational-exp
128 :operator 'in :sub-expressions rest))
130 (defsql sql-|| (:symbol "||") (&rest rest)
131 (make-instance 'sql-relational-exp
132 :operator '|| :sub-expressions rest))
134 (defsql sql-is (:symbol "is") (&rest rest)
135 (make-instance 'sql-relational-exp
136 :operator 'is :sub-expressions rest))
138 (defsql sql-= (:symbol "=") (&rest rest)
139 (make-instance 'sql-relational-exp
140 :operator '= :sub-expressions rest))
142 (defsql sql-== (:symbol "==") (&rest rest)
143 (make-instance 'sql-assignment-exp
144 :operator '= :sub-expressions rest))
146 (defsql sql-< (:symbol "<") (&rest rest)
147 (make-instance 'sql-relational-exp
148 :operator '< :sub-expressions rest))
151 (defsql sql-> (:symbol ">") (&rest rest)
152 (make-instance 'sql-relational-exp
153 :operator '> :sub-expressions rest))
155 (defsql sql-<> (:symbol "<>") (&rest rest)
156 (make-instance 'sql-relational-exp
157 :operator '<> :sub-expressions rest))
159 (defsql sql->= (:symbol ">=") (&rest rest)
160 (make-instance 'sql-relational-exp
161 :operator '>= :sub-expressions rest))
163 (defsql sql-<= (:symbol "<=") (&rest rest)
164 (make-instance 'sql-relational-exp
165 :operator '<= :sub-expressions rest))
167 (defsql sql-count (:symbol "count") (&rest rest)
168 (make-instance 'sql-function-exp
169 :name 'count :args rest))
171 (defsql sql-max (:symbol "max") (&rest rest)
172 (make-instance 'sql-function-exp
173 :name 'max :args rest))
175 (defsql sql-min (:symbol "min") (&rest rest)
176 (make-instance 'sql-function-exp
177 :name 'min :args rest))
179 (defsql sql-avg (:symbol "avg") (&rest rest)
180 (make-instance 'sql-function-exp
181 :name 'avg :args rest))
183 (defsql sql-sum (:symbol "sum") (&rest rest)
184 (make-instance 'sql-function-exp
185 :name 'sum :args rest))
187 (defsql sql-the (:symbol "the") (&rest rest)
188 (make-instance 'sql-typecast-exp
189 :modifier (first rest) :components (second rest)))
191 (defsql sql-function (:symbol "function") (&rest args)
192 (make-instance 'sql-function-exp
193 :name (make-symbol (car args)) :args (cdr args)))
195 ;;(defsql sql-distinct (:symbol "distinct") (&rest rest)
198 ;;(defsql sql-between (:symbol "between") (&rest rest)