(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)))))
+
+
+
#:write-large-object
#:read-large-object
#:delete-large-object
+ #:do-query
+ #:map-query
;; Transactions
#:with-transaction
(: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"))
))))
-cl-sql (2.1.2-1) unstable; urgency=low
+cl-sql (2.1.4-1) unstable; urgency=low
* New upstream
- -- Kevin M. Rosenberg <kmr@debian.org> Tue, 6 Apr 2004 00:56:21 -0600
+ -- Kevin M. Rosenberg <kmr@debian.org> Tue, 6 Apr 2004 07:40:36 -0600
cl-sql (2.0.0-2) unstable; urgency=low
(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*))
#:write-large-object
#:read-large-object
#:delete-large-object
+ #:do-query
+ #:map-query
;; Transactions
#:with-transaction
))
(: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#
)
(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
#: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
;; 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)
projects / clsql.git / commitdiff