(defun column-names ()  (join "~%" (map 'list #'sqlcol-name (columns)))); GETHASH-REQUIRED; Get the value of a column - must exist if the hash table is non-empty(defun gethash-required (key hash)  (if (= 0 (hash-table-count hash))      nil    (multiple-value-bind     (val exists) (gethash (to-string key) hash)     (when (not exists) (error (cat "DO-ROWS: bound variable '" key "' does not occur in the query."                                    "~%The allowed column/variable names are:~%~%" (column-names)                                    "~%")))     val)))                       ; ROW-TO-RESULT; Convert fetched row array data to result type(defun row-to-result (row result-type)  (cond ((null row) nil)        ((eq result-type 'ARRAY) row)        ; ((eq result-type 'HASH) (pairs-to-hash (row-to-result row 'PAIRS)))        ((eq result-type 'HASH) (array-to-hash (row-to-result row 'ARRAY)))        ((eq result-type 'PAIRS)         (let ((colinfo (oracle_column_info (curconn))))           (check-success)           (cond            ((null row) nil)            (t (map 'list                    #'(lambda (col rowval)                        (list (sqlcol-name col) rowval))                    colinfo row)))))        (t (error (cat "Invalid result type '" result-type "' given - should be 'ARRAY, 'PAIRS or 'HASH"))))); CHECK-SUCCESS; Check Oracle success code after calling a function.  Assumes (check-connection) was called!(defun check-success ()  (if (not (lisp-truth (oracle_success (curconn))))      (error (oracle_last_error (curconn))))  t); Convert Oracle type based on sqlcol data type.  Oracle numerics are converted; to the appropriate internal Lisp type using READ-FROM-STRING.  NULL is retained; as Lisp NIL, and strings and dates are left as Lisp string.(defun convert-type (val sc)  (let ((dtype (sqlcol-type sc)))    (cond ((null val) nil)          ((find dtype '("NUMBER" "INTEGER" "FLOAT") :test #'equal)           (read-from-string val))          ((find dtype '("VARCHAR" "DATE" "CHAR" "VARCHAR2") :test #'equal)           val)          (t (error (cat "Unsupported data type '" dtype "'")))))); TO-SQLVAL; Return a SQL val for LISP object, handling null case(defun to-sqlval (x)  (if (null x)      (make-sqlval :data "" :is_null 1)    (make-sqlval :data (to-string x) :is_null 0))); FROM-SQLVAL; Return Lisp Object (string or NIL) for SQL val, handling null case(defun from-sqlval (x)  (if (lisp-truth (sqlval-is_null x))      nil    (sqlval-data x))); ROWVAL; Return string value of an SQLVAL (row value), or "" if null(defun rowval (row) (if (= 0 (sqlval-is_null row))                        (sqlval-data row)                      nil)); HASH-TO-SQLPARAM-ARRAY; Convert a hash table map of name->value strings to an array of SQL; bind params suitable for passing to ORACLE_EXEC_SQL(defun hash-to-sqlparam-array (h)  (if (null h) (setf h (make-hash-table :test #'equal)))  (let* ((count (hash-table-count h))         (result (make-array count))         (i 0))    (loop for key being the hash-keys of h do          (let ((val (gethash key h)))            (when (not (atom key))                  (error "Non-atom parameter name in bind-parameter hash"))            (when (not (atom val))                  (error "Non-atom parameter value in bind-parameter hash"))            (setf (aref result i) (make-sqlparam :name (to-string key) :value (to-sqlval val)))            (incf i)))    result)); CHECK-CONNECTION; Check we are connected before doing an operation that requires a connection(defun check-connection (&optional action)  (if (null (curconn))      (error (cat "Attempt to "                  (if-null action "perform database operation")                  " when not connected to any database")))); CONNECTION-KEY; Construct key suitable for use in hash table keyed on; unique triple of (user, schema, server)(defun connection-key (user schema server)  ; Use ~-delimited string - pretty disgusting, eh?  (cat (string-upcase user) "~" (string-upcase schema) "~" (string-upcase server))); PAIRS-TO-HASH; Convert a list of pairs ((key1 val1) (key2 val2) ...) to hash, enforcing key uniqueness(defun pairs-to-hash (plist)  (if (null plist)      nil    (let ((result (make-hash-table :test #'equal)))      (loop for p in plist do            (let ((key (string-upcase (to-string (first p))))                  (value (second p)))              (when (not (valid-symbol key)) (error (cat "Column or parameter '" key "' is not a valid Lisp symbol name."                                                         "~%Consider using SELECT ... " key " AS <column alias>")))              ; Check uniqueness              (multiple-value-bind                (curval already-there) (gethash key result)               (when already-there (error (cat "Column or parameter '" key                                               "' appears twice in list of (name, value) pairs,~%first with value '"                                               curval "' and again with value '" value "'.  Columns/parameters given were:~%"                                               (join "~%" (map 'list #'car plist))                                               (nl)))))              (setf (gethash key result) value)))      result))); CHECK-PAIRS; Convert pairs to hash if needed(defun check-pairs (p)  (cond ((null p) (make-hash-table :test #'equal))        ((eq (type-of p) 'HASH-TABLE) p)        ((eq (type-of p) 'CONS) (pairs-to-hash p))        (t (error (cat "Invalid type for name -> value map: '" (type-of p) "' - should be hash or list of pairs."))))); COMMA-LIST-OF-KEYS; Return keys of hash table as comma-separated list.  If flag given,; also pre-pend a colon to the name(defun comma-list-of-keys (h &optional (colon nil))  (let ((result "")        (plural nil))    (loop for hkey being each hash-key of h do          (if plural              (setf result (cat result ", "))            (setf plural t))          (when colon (setf result (cat result ":")))          (setf result (cat result hkey)))    result)); IS-SELECT-QUERY; Examine string to see if it begins with "SELECT".  Useful to auto-detect; the mode (SELECT vs. non-SELECT for executing statements.(defun is-select-query (s)  (let ((start (string-trim '(#\Space #\Tab #\Newline) (string-upcase s))))    (equal "SELECT" (subseq start 0 6)))); =-=-=-=-=-=-=-   C WRAPPER FUNCTIONS  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-; CONNECT(def-call-out oracle_connect (:arguments (user           c-string)                                         (schema         c-string)                                         (password       c-string)                                         (server         c-string)                                         (prefetch_bytes int)                                         (auto_commit    int))                             (:return-type c-pointer)); DISCONNECT(def-call-out oracle_disconnect (:arguments (db c-pointer))                                (:return-type int  )); RUN SQL(def-call-out oracle_exec_sql (:arguments (db         c-pointer)                                          (sql        c-string)                                          (params     (c-array-ptr (c-ptr sqlparam)))                                          (is_command int))                              (:return-type int)); NO. OF COLUMNS(def-call-out oracle_ncol (:arguments (db c-pointer))                          (:return-type int)); COLUMN INFO(def-call-out oracle_column_info (:arguments (db c-pointer))                                 (:return-type (c-array-ptr (c-ptr sqlcol)))); FETCH(def-call-out oracle_fetch_row (:arguments (db c-pointer))                               (:return-type int)); EOF(def-call-out oracle_eof (:arguments (db c-pointer))                         (:return-type int)); SUCCESS(def-call-out oracle_success (:arguments (db c-pointer))                             (:return-type int)); ROW VALUES(def-call-out oracle_row_values (:arguments (db c-pointer))                                (:return-type (c-array-ptr (c-ptr sqlval)))); NO. ROWS AFFECTED(def-call-out oracle_rows_affected (:arguments (db c-pointer))                                   (:return-type int)); COMMIT(def-call-out oracle_commit (:arguments (db c-pointer))                            (:return-type int))(def-call-out oracle_rollback (:arguments (db c-pointer))                              (:return-type int))(def-call-out oracle_set_auto_commit (:arguments (db c-pointer)                                                 (auto_commit int))                                     (:return-type int)); ERROR(def-call-out oracle_last_error (:arguments (db c-pointer))                                (:return-type c-string)); =-=-=-=-=-=-=-   LOW LEVEL UTILITY FUNCTIONS  =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-; IF-NULL; Default a null value.  Is there a better Lisp built-in for this?(defun if-null (value default) (if (null value) default value)); AREF-NULL; Do an AREF, but allow array to be null, in which case return NIL(defun aref-null (a i) (if (null a) nil (aref a i))); HASH-COMBINE; Combine two hash table.  Keys of the second hash will overwrite.(defun hash-combine (h1 h2)  (cond ((null h1) h2)        ((null h2) h1)        (t (loop for hkey being each hash-key of h2 do                 (setf (gethash hkey h1)                       (gethash hkey h2)))           h1))); VALID-SYMBOL; Test whether string is a valid Lisp symbol name(defun valid-symbol (x)  (equal (string-upcase (to-string x))         (to-string (read-from-string x)))); TO-STRING; Convert object to a string; NIL -> ""(defun to-string (s)  (cond ((null s) "")        ((stringp s) s)        ((symbolp s) (symbol-name s))        (t (format nil "~A" s)))); CAT; Concatenate strings(defun cat (&rest args)   (apply #'concatenate 'string (mapcar #'to-string (flatten args)))); ARRAY-TO-HASH; Convert array of row values to hash using column info(defun array-to-hash (row)  (if (null row)      nil    (let* ((cols (columns))           (n (length row))           (result (make-hash-table :test #'equal :size n)))      (loop for i from 0 to (- n 1) do            (setf (gethash (to-string (sqlcol-name (aref cols i))) result) (aref row i)))      result))); CHECK-UNIQUE-ELEMENTS; Does list consist of unqiue, non-null elements(defun check-unique-elements (l)  (let ((h (make-hash-table :test #'equal)))    (dolist (elt l)            (when (null elt)                  (error "Null element in column/variable list"))            (when (gethash (to-string elt) h)                  (error (cat "DO-ROWS: Parameter/column '" elt "' occurs more than once in bound columns/variables:~%"                              (join "~%" l))))            (setf (gethash (to-string elt) h) t))    t)); JOIN; Join a sequence of strings into one, separating with delimeter; I'll probably get shot for this implementation.  Better way?(defun join (delimiter seq)  (let ((result ""))    (loop for i from 0 to (- (length seq) 1) do          (when (> i 0)                (setf result (cat result delimiter)))          (setf result (cat result (nth i seq))))    result)); WHILE (macro); While loop construct (lifted from Paul Graham)(defmacro while (test &body body)  `(do ()       ((not ,test))     ,@body)); OUT; Output functions(defun out (&rest args)  (format t "~A" (cat args))); OUT-NL(defun out-nl (&rest args)  (out args)  (terpri)); LISP-TRUTH; Get Lisp truth of object, considering "C" 0/1 also.  Useful for; taking booleans returned from "C"(defun lisp-truth (x)  (if (eq x 0) nil (not (null x)))); C-TRUTH; Get "C" truth of object (0 or 1).  Useful for passing args to "C"(defun c-truth (x)  (if (lisp-truth x) 1 0)); FLATTEN; Flatten list (lifted from Paul Graham)(defun flatten (x)  (labels ((rec (x acc)             (cond ((null x) acc)                   ((atom x) (cons x acc))                   (t (rec (car x) (rec (cdr x) acc))))))    (rec x nil))); NL; Return newline(defun nl () (format nil "~%")); End of oracle.lisp