X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=usql%2Fsyntax.lisp;fp=usql%2Fsyntax.lisp;h=0000000000000000000000000000000000000000;hb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f;hp=f3f8372ead60213381c58282821bb4c8ed757d10;hpb=39d3fefaebf35a19a211d1ab6552d7ff54faccd2;p=clsql.git diff --git a/usql/syntax.lisp b/usql/syntax.lisp deleted file mode 100644 index f3f8372..0000000 --- a/usql/syntax.lisp +++ /dev/null @@ -1,168 +0,0 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ====================================================================== -;;;; File: package.lisp -;;;; Updated: <04/04/2004 12:05:16 marcusp> -;;;; ====================================================================== -;;;; -;;;; Description ========================================================== -;;;; ====================================================================== -;;;; -;;;; CLSQL-USQL square bracket symbolic query syntax. Functions for -;;;; enabling and disabling the syntax and for building SQL -;;;; expressions using the syntax. -;;;; -;;;; ====================================================================== - -(in-package :clsql-usql-sys) - -(defvar *original-reader-enter* nil) - -(defvar *original-reader-exit* nil) - -(defvar *sql-macro-open-char* #\[) - -(defvar *sql-macro-close-char* #\]) - -(defvar *restore-sql-reader-syntax* nil) - - -;; Exported functions for disabling SQL syntax. - -(defmacro disable-sql-reader-syntax () - "Turn off SQL square bracket syntax changing syntax state. Set state -such that RESTORE-SQL-READER-SYNTAX-STATE will make the syntax -disabled if it is consequently locally enabled." - '(eval-when (:compile-toplevel :load-toplevel :execute) - (setf *restore-sql-reader-syntax* nil) - (%disable-sql-reader-syntax))) - -(defmacro locally-disable-sql-reader-syntax () - "Turn off SQL square bracket syntax and do not change syntax state." - '(eval-when (:compile-toplevel :load-toplevel :execute) - (%disable-sql-reader-syntax))) - -(defun %disable-sql-reader-syntax () - (when *original-reader-enter* - (set-macro-character *sql-macro-open-char* *original-reader-enter*)) - (setf *original-reader-enter* nil) - (values)) - - -;; Exported functions for enabling SQL syntax. - -(defmacro enable-sql-reader-syntax () - "Turn on SQL square bracket syntax changing syntax state. Set state -such that RESTORE-SQL-READER-SYNTAX-STATE will make the syntax enabled -if it is consequently locally disabled." - '(eval-when (:compile-toplevel :load-toplevel :execute) - (setf *restore-sql-reader-syntax* t) - (%enable-sql-reader-syntax))) - -(defmacro locally-enable-sql-reader-syntax () - "Turn on SQL square bracket syntax and do not change syntax state." - '(eval-when (:compile-toplevel :load-toplevel :execute) - (%enable-sql-reader-syntax))) - -(defun %enable-sql-reader-syntax () - (unless *original-reader-enter* - (setf *original-reader-enter* (get-macro-character *sql-macro-open-char*))) - (set-macro-character *sql-macro-open-char* #'sql-reader-open) - (enable-sql-close-syntax) - (values)) - -(defmacro restore-sql-reader-syntax-state () - "Sets the enable/disable square bracket syntax state to reflect the -last call to either DISABLE-SQL-READER-SYNTAX or -ENABLE-SQL-READER-SYNTAX. The default state of the square bracket -syntax is disabled." - '(eval-when (:compile-toplevel :load-toplevel :execute) - (if *restore-sql-reader-syntax* - (%enable-sql-reader-syntax) - (%disable-sql-reader-syntax)))) - -(defun sql-reader-open (stream char) - (declare (ignore char)) - (let ((sqllist (read-delimited-list #\] stream t))) - (if (sql-operator (car sqllist)) - (cons (sql-operator (car sqllist)) (cdr sqllist)) - (apply #'generate-sql-reference sqllist)))) - -;; Internal function that disables the close syntax when leaving sql context. -(defun disable-sql-close-syntax () - (set-macro-character *sql-macro-close-char* *original-reader-exit*) - (setf *original-reader-exit* nil)) - -;; Internal function that enables close syntax when entering SQL context. -(defun enable-sql-close-syntax () - (setf *original-reader-exit* (get-macro-character *sql-macro-close-char*)) - (set-macro-character *sql-macro-close-char* (get-macro-character #\)))) - -(defun generate-sql-reference (&rest arglist) - (cond ((= (length arglist) 1) ; string, table or attribute - (if (stringp (car arglist)) - (sql-expression :string (car arglist)) - (sql-expression :attribute (car arglist)))) - ((<= 2 (length arglist)) - (let ((sqltype (if (keywordp (caddr arglist)) - (caddr arglist) nil)) - (sqlparam (if (keywordp (caddr arglist)) - (caddr arglist)))) - (cond - ((stringp (cadr arglist)) - (sql-expression :table (car arglist) - :alias (cadr arglist) - :type sqltype)) - ((keywordp (cadr arglist)) - (sql-expression :attribute (car arglist) - :type (cadr arglist) - :params sqlparam)) - (t - (sql-expression :attribute (cadr arglist) - :table (car arglist) - :params sqlparam - :type sqltype))))) - (t - (error 'clsql-sql-syntax-error :reason "bad expression syntax")))) - - -;; Exported functions for dealing with SQL syntax - -(defun sql (&rest args) - "Generates SQL from a set of expressions given by ARGS. Each -argument is translated into SQL and then the args are concatenated -with a single space between each pair." - (format nil "~{~A~^ ~}" (mapcar #'sql-output args))) - -(defun sql-expression (&key string table alias attribute type params) - "Generates an SQL expression from the given keywords. Valid -combinations of the arguments are: string; table; table and alias; -table and attribute; table, attribute, and type; table or alias, and -attribute; table or alias, and attribute and type; attribute; and -attribute and type." - (cond - (string - (make-instance 'sql :string string)) - (attribute - (make-instance 'sql-ident-attribute :name attribute - :qualifier (or table alias) - :type type - :params params)) - ((and table (not attribute)) - (make-instance 'sql-ident-table :name table - :table-alias alias)))) - -(defun sql-operator (operation) - "Takes an SQL operator as an argument and returns the Lisp symbol -for the operator." - (typecase operation - (string nil) - (symbol (gethash (string-upcase (symbol-name operation)) - *sql-op-table*)))) - -(defun sql-operation (operation &rest rest) - "Generates an SQL statement from an operator and arguments." - (if (sql-operator operation) - (apply (symbol-function (sql-operator operation)) rest) - (error "~A is not a recognized SQL operator." operation))) - -