From 23e7f17ba8c579cf935325f4004aad747d33cce8 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 6 Apr 2004 13:41:21 +0000 Subject: [PATCH] r8832: changes for allow import of clsql and clsql-usql in the same package --- base/basic-sql.lisp | 108 ++++++++++++++++++++++++++++++++++++++++++ base/package.lisp | 2 + clsql-base.asd | 2 +- debian/changelog | 4 +- sql/functional.lisp | 10 ++-- sql/package.lisp | 17 +++---- sql/sql.lisp | 108 ------------------------------------------ usql/package.lisp | 4 +- usql/sql.lisp | 113 -------------------------------------------- 9 files changed, 132 insertions(+), 236 deletions(-) diff --git a/base/basic-sql.lisp b/base/basic-sql.lisp index df5d93b..ea9245e 100644 --- a/base/basic-sql.lisp +++ b/base/basic-sql.lisp @@ -50,3 +50,111 @@ pair.")) (values)) +(defmacro do-query (((&rest args) query-expression + &key (database '*default-database*) (types nil)) + &body body) + "Repeatedly executes BODY within a binding of ARGS on the attributes +of each record resulting from QUERY. The return value is determined by +the result of executing BODY. The default value of DATABASE is +*DEFAULT-DATABASE*." + (let ((result-set (gensym)) + (columns (gensym)) + (row (gensym)) + (db (gensym))) + `(let ((,db ,database)) + (multiple-value-bind (,result-set ,columns) + (database-query-result-set ,query-expression ,db + :full-set nil :types ,types) + (when ,result-set + (unwind-protect + (do ((,row (make-list ,columns))) + ((not (database-store-next-row ,result-set ,db ,row)) + nil) + (destructuring-bind ,args ,row + ,@body)) + (database-dump-result-set ,result-set ,db))))))) + +(defun map-query (output-type-spec function query-expression + &key (database *default-database*) + (types nil)) + "Map the function over all tuples that are returned by the query in +query-expression. The results of the function are collected as +specified in output-type-spec and returned like in MAP." + (macrolet ((type-specifier-atom (type) + `(if (atom ,type) ,type (car ,type)))) + (case (type-specifier-atom output-type-spec) + ((nil) + (map-query-for-effect function query-expression database types)) + (list + (map-query-to-list function query-expression database types)) + ((simple-vector simple-string vector string array simple-array + bit-vector simple-bit-vector base-string + simple-base-string) + (map-query-to-simple output-type-spec function query-expression database types)) + (t + (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t) + function query-expression :database database :types types))))) + +(defun map-query-for-effect (function query-expression database types) + (multiple-value-bind (result-set columns) + (database-query-result-set query-expression database :full-set nil + :types types) + (when result-set + (unwind-protect + (do ((row (make-list columns))) + ((not (database-store-next-row result-set database row)) + nil) + (apply function row)) + (database-dump-result-set result-set database))))) + +(defun map-query-to-list (function query-expression database types) + (multiple-value-bind (result-set columns) + (database-query-result-set query-expression database :full-set nil + :types types) + (when result-set + (unwind-protect + (let ((result (list nil))) + (do ((row (make-list columns)) + (current-cons result (cdr current-cons))) + ((not (database-store-next-row result-set database row)) + (cdr result)) + (rplacd current-cons (list (apply function row))))) + (database-dump-result-set result-set database))))) + + +(defun map-query-to-simple (output-type-spec function query-expression database types) + (multiple-value-bind (result-set columns rows) + (database-query-result-set query-expression database :full-set t + :types types) + (when result-set + (unwind-protect + (if rows + ;; We know the row count in advance, so we allocate once + (do ((result + (cmucl-compat:make-sequence-of-type output-type-spec rows)) + (row (make-list columns)) + (index 0 (1+ index))) + ((not (database-store-next-row result-set database row)) + result) + (declare (fixnum index)) + (setf (aref result index) + (apply function row))) + ;; Database can't report row count in advance, so we have + ;; to grow and shrink our vector dynamically + (do ((result + (cmucl-compat:make-sequence-of-type output-type-spec 100)) + (allocated-length 100) + (row (make-list columns)) + (index 0 (1+ index))) + ((not (database-store-next-row result-set database row)) + (cmucl-compat:shrink-vector result index)) + (declare (fixnum allocated-length index)) + (when (>= index allocated-length) + (setq allocated-length (* allocated-length 2) + result (adjust-array result allocated-length))) + (setf (aref result index) + (apply function row)))) + (database-dump-result-set result-set database))))) + + + diff --git a/base/package.lisp b/base/package.lisp index ba3eeec..dd2c674 100644 --- a/base/package.lisp +++ b/base/package.lisp @@ -231,6 +231,8 @@ #:write-large-object #:read-large-object #:delete-large-object + #:do-query + #:map-query ;; Transactions #:with-transaction diff --git a/clsql-base.asd b/clsql-base.asd index f535a3a..4a13f78 100644 --- a/clsql-base.asd +++ b/clsql-base.asd @@ -45,7 +45,7 @@ (:file "time" :depends-on ("package")) (:file "database" :depends-on ("initialize")) (:file "recording" :depends-on ("time" "database")) - (:file "basic-sql" :depends-on ("database")) + (:file "basic-sql" :depends-on ("database" "cmucl-compat")) (:file "pool" :depends-on ("basic-sql")) (:file "transaction" :depends-on ("basic-sql")) )))) diff --git a/debian/changelog b/debian/changelog index c50ca19..be965ba 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,8 @@ -cl-sql (2.1.2-1) unstable; urgency=low +cl-sql (2.1.4-1) unstable; urgency=low * New upstream - -- Kevin M. Rosenberg Tue, 6 Apr 2004 00:56:21 -0600 + -- Kevin M. Rosenberg Tue, 6 Apr 2004 07:40:36 -0600 cl-sql (2.0.0-2) unstable; urgency=low diff --git a/sql/functional.lisp b/sql/functional.lisp index dd8aa04..bf38a12 100644 --- a/sql/functional.lisp +++ b/sql/functional.lisp @@ -29,9 +29,13 @@ (in-package #:clsql-sys) -;;;; This file implements the more advanced functions of the -;;;; functional SQL interface, which are just nicer layers above the -;;;; basic SQL interface. +;;; This file implements the more advanced functions of the +;;; functional SQL interface, which are just nicer layers above the +;;; basic SQL interface. + +;;; With the integration of CLSQL-USQL, these functions are no +;;; longer exported by the CLSQL package since they conflict with names +;;; exported by CLSQL-USQL (defun insert-records (&key into attributes values av-pairs query (database *default-database*)) diff --git a/sql/package.lisp b/sql/package.lisp index 7d8b8b2..44eecaa 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -95,6 +95,8 @@ #:write-large-object #:read-large-object #:delete-large-object + #:do-query + #:map-query ;; Transactions #:with-transaction @@ -116,22 +118,21 @@ )) (:export ;; sql.cl - #:map-query - #:do-query #:for-each-row - ;; functional.cl - #:insert-records - #:delete-records - #:update-records - #:with-database - ;; Large objects (Marc B) #:create-large-object #:write-large-object #:read-large-object #:delete-large-object + ;; functional.lisp + ;; These are no longer export since different functions are + ;; exported by the CLSQL-USQL package + ;; #:insert-records + ;; #:delete-records + ;; #:update-records + . #1# ) diff --git a/sql/sql.lisp b/sql/sql.lisp index d46bdcf..7e36da8 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -20,114 +20,6 @@ (in-package #:clsql-sys) -(defun map-query (output-type-spec function query-expression - &key (database *default-database*) - (types nil)) - "Map the function over all tuples that are returned by the query in -query-expression. The results of the function are collected as -specified in output-type-spec and returned like in MAP." - ;; DANGER Will Robinson: Parts of the code for implementing - ;; map-query (including the code below and the helper functions - ;; called) are highly CMU CL specific. - ;; KMR -- these have been replaced with cross-platform instructions above - (macrolet ((type-specifier-atom (type) - `(if (atom ,type) ,type (car ,type)))) - (case (type-specifier-atom output-type-spec) - ((nil) - (map-query-for-effect function query-expression database types)) - (list - (map-query-to-list function query-expression database types)) - ((simple-vector simple-string vector string array simple-array - bit-vector simple-bit-vector base-string - simple-base-string) - (map-query-to-simple output-type-spec function query-expression database types)) - (t - (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t) - function query-expression :database database :types types))))) - -(defun map-query-for-effect (function query-expression database types) - (multiple-value-bind (result-set columns) - (database-query-result-set query-expression database :full-set nil - :types types) - (when result-set - (unwind-protect - (do ((row (make-list columns))) - ((not (database-store-next-row result-set database row)) - nil) - (apply function row)) - (database-dump-result-set result-set database))))) - -(defun map-query-to-list (function query-expression database types) - (multiple-value-bind (result-set columns) - (database-query-result-set query-expression database :full-set nil - :types types) - (when result-set - (unwind-protect - (let ((result (list nil))) - (do ((row (make-list columns)) - (current-cons result (cdr current-cons))) - ((not (database-store-next-row result-set database row)) - (cdr result)) - (rplacd current-cons (list (apply function row))))) - (database-dump-result-set result-set database))))) - - -(defun map-query-to-simple (output-type-spec function query-expression database types) - (multiple-value-bind (result-set columns rows) - (database-query-result-set query-expression database :full-set t - :types types) - (when result-set - (unwind-protect - (if rows - ;; We know the row count in advance, so we allocate once - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec rows)) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - result) - (declare (fixnum index)) - (setf (aref result index) - (apply function row))) - ;; Database can't report row count in advance, so we have - ;; to grow and shrink our vector dynamically - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec 100)) - (allocated-length 100) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - (cmucl-compat:shrink-vector result index)) - (declare (fixnum allocated-length index)) - (when (>= index allocated-length) - (setq allocated-length (* allocated-length 2) - result (adjust-array result allocated-length))) - (setf (aref result index) - (apply function row)))) - (database-dump-result-set result-set database))))) - -(defmacro do-query (((&rest args) query-expression - &key (database '*default-database*) - (types nil)) - &body body) - (let ((result-set (gensym)) - (columns (gensym)) - (row (gensym)) - (db (gensym))) - `(let ((,db ,database)) - (multiple-value-bind (,result-set ,columns) - (database-query-result-set ,query-expression ,db - :full-set nil :types ,types) - (when ,result-set - (unwind-protect - (do ((,row (make-list ,columns))) - ((not (database-store-next-row ,result-set ,db ,row)) - nil) - (destructuring-bind ,args ,row - ,@body)) - (database-dump-result-set ,result-set ,db))))))) - - ;;; Row processing macro diff --git a/usql/package.lisp b/usql/package.lisp index daacdf1..39f16a9 100644 --- a/usql/package.lisp +++ b/usql/package.lisp @@ -193,7 +193,9 @@ #:write-large-object #:read-large-object #:delete-large-object - + #:do-query + #:map-query + ;; recording.lisp -- SQL I/O Recording #:record-sql-comand #:record-sql-result diff --git a/usql/sql.lisp b/usql/sql.lisp index f700c17..b5c7284 100644 --- a/usql/sql.lisp +++ b/usql/sql.lisp @@ -145,119 +145,6 @@ condition is true." ;; iteration -(defun map-query (output-type-spec function query-expression - &key (database *default-database*) - (types nil)) - "Map the function over all tuples that are returned by the query in -query-expression. The results of the function are collected as -specified in output-type-spec and returned like in MAP." - ;; DANGER Will Robinson: Parts of the code for implementing - ;; map-query (including the code below and the helper functions - ;; called) are highly CMU CL specific. - ;; KMR -- these have been replaced with cross-platform instructions above - (macrolet ((type-specifier-atom (type) - `(if (atom ,type) ,type (car ,type)))) - (case (type-specifier-atom output-type-spec) - ((nil) - (map-query-for-effect function query-expression database types)) - (list - (map-query-to-list function query-expression database types)) - ((simple-vector simple-string vector string array simple-array - bit-vector simple-bit-vector base-string - simple-base-string) - (map-query-to-simple output-type-spec function query-expression - database types)) - (t - (funcall #'map-query - (cmucl-compat:result-type-or-lose output-type-spec t) - function query-expression :database database :types types))))) - -(defun map-query-for-effect (function query-expression database types) - (multiple-value-bind (result-set columns) - (database-query-result-set query-expression database :full-set nil - :types types) - (when result-set - (unwind-protect - (do ((row (make-list columns))) - ((not (database-store-next-row result-set database row)) - nil) - (apply function row)) - (database-dump-result-set result-set database))))) - -(defun map-query-to-list (function query-expression database types) - (multiple-value-bind (result-set columns) - (database-query-result-set query-expression database :full-set nil - :types types) - (when result-set - (unwind-protect - (let ((result (list nil))) - (do ((row (make-list columns)) - (current-cons result (cdr current-cons))) - ((not (database-store-next-row result-set database row)) - (cdr result)) - (rplacd current-cons (list (apply function row))))) - (database-dump-result-set result-set database))))) - -(defun map-query-to-simple (output-type-spec function query-expression - database types) - (multiple-value-bind (result-set columns rows) - (database-query-result-set query-expression database :full-set t - :types types) - (when result-set - (unwind-protect - (if rows - ;; We know the row count in advance, so we allocate once - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec rows)) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - result) - (declare (fixnum index)) - (setf (aref result index) - (apply function row))) - ;; Database can't report row count in advance, so we have - ;; to grow and shrink our vector dynamically - (do ((result - (cmucl-compat:make-sequence-of-type output-type-spec 100)) - (allocated-length 100) - (row (make-list columns)) - (index 0 (1+ index))) - ((not (database-store-next-row result-set database row)) - (cmucl-compat:shrink-vector result index)) - (declare (fixnum allocated-length index)) - (when (>= index allocated-length) - (setf allocated-length (* allocated-length 2) - result (adjust-array result allocated-length))) - (setf (aref result index) - (apply function row)))) - (database-dump-result-set result-set database))))) - -(defmacro do-query (((&rest args) query-expression - &key (database '*default-database*) (types nil)) - &body body) - "Repeatedly executes BODY within a binding of ARGS on the attributes -of each record resulting from QUERY. The return value is determined by -the result of executing BODY. The default value of DATABASE is -*DEFAULT-DATABASE*." - (let ((result-set (gensym)) - (columns (gensym)) - (row (gensym)) - (db (gensym))) - `(let ((,db ,database)) - (multiple-value-bind (,result-set ,columns) - (database-query-result-set ,query-expression ,db - :full-set nil :types ,types) - (when ,result-set - (unwind-protect - (do ((,row (make-list ,columns))) - ((not (database-store-next-row ,result-set ,db ,row)) - nil) - (destructuring-bind ,args ,row - ,@body)) - (database-dump-result-set ,result-set ,db))))))) - - ;; output-sql (defmethod database-output-sql ((str string) database) -- 2.34.1