r4820: *** empty log message ***

[umlisp.git] / sql-create.lisp

diff --git a/sql-create.lisp b/sql-create.lisp
index 101a02a06a0debfac257b5450cb1c287b55749e8..236b137ed763c7aea20df66b7f9ac7c738f4cd1a 100644 (file)
--- a/sql-create.lisp
+++ b/sql-create.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-create.lisp,v 1.6 2003/05/04 08:55:52 kevin Exp $
+;;;; $Id: sql-create.lisp,v 1.7 2003/05/05 23:13:28 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -94,10 +94,11 @@
           (let ((q (umls-col-quotechar col)))
             (concatenate 'string q (insert-col-value col value) q)))))
     (format
-     nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~{~a~^,~})"
+     nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
      (umls-file-table file)
      (umls-file-fields file)
-     (append
+     (concat-separated-strings
+      "," 
       (mapcar insert-func (remove-custom-cols (umls-file-colstructs file)) values)
       (custom-col-values (custom-colstructs-for-file file) values t)))))
 
@@ -114,7 +115,7 @@
                       delim)))
     result))
 
-(defun col-value (col doquote values)
+(defun custom-col-value (col doquote values)
   (let ((custom-value (funcall (umls-col-custom-value-func col) values)))
     (if doquote
        (let ((q (umls-col-quotechar col)))
@@ -123,7 +124,7 @@
 
 (defun custom-col-values (colstructs values doquote)
   "Returns a list of string column values for SQL inserts for custom columns"
-  (loop for col in colstructs collect (col-value col doquote values)))
+  (loop for col in colstructs collect (custom-col-value col doquote values)))
 
 
 (defun remove-custom-cols (cols)
@@ -236,7 +237,7 @@ This is much faster that using create-umls-db-insert."
   (with-sql-connection (conn)
     (sql-drop-tables conn)
     (sql-create-tables conn)
-    (mapcar 
+    (map 'nil 
      #'(lambda (file) (sql-execute (funcall copy-cmd file extension) conn)) 
      *umls-files*)
     (sql-create-indexes conn)
@@ -247,7 +248,7 @@ This is much faster that using create-umls-db-insert."
 (defun translate-all-files (&optional (extension ".trans"))
   "Copy translated files and return postgresql copy commands to import"
   (make-noneng-index-file extension)
-  (mapcar (lambda (f) (translate-file f extension)) *umls-files*))
+  (map 'nil (lambda (f) (translate-file f extension)) *umls-files*))
 
 (defun translate-file (file extension)
   "Translate a umls file into a format suitable for sql copy cmd"
@@ -258,7 +259,7 @@ This is much faster that using create-umls-db-insert."
          nil)
        (with-open-file (ostream path :direction :output)
          (with-umls-file (line (umls-file-fil file))
-           (princ (umls-translate file line) ostream)
+           (umls-translate file line ostream)
            (princ #\newline ostream))
          t))))
 
@@ -275,7 +276,7 @@ This is much faster that using create-umls-db-insert."
          (with-open-file (ostream path :direction :output)
            (dolist (inputfile (noneng-lang-index-files))
              (with-umls-file (line (umls-file-fil inputfile))
-               (princ (umls-translate outfile line) ostream) ;; use outfile for custom cols
+               (umls-translate outfile line ostream) ;; use outfile for custom cols
                (princ #\newline ostream))))
          t))))
 
@@ -305,20 +306,34 @@ This is much faster that using create-umls-db-insert."
                 line)
                (custom-col-values-old (custom-colstructs-for-file file) line "|" nil))))
 
-(defun umls-translate (file line)
+(defun concat-separated-strings (separator &rest lists)
+  (format nil (format nil "~~{~~A~~^~A~~}" separator) (mapappend #'identity lists)))
+
+(defun print-separated-strings (strm separator &rest lists)
+  (declare (optimize (speed 3) (safety 0) (space 0) (debug 0) (compilation-speed 0)))
+  (do* ((rest-lists lists (cdr rest-lists))
+       (list (car rest-lists) (car rest-lists))
+       (last-list (null (cdr rest-lists)) (null (cdr rest-lists))))
+       ((null list) strm)
+    (do* ((lst list (cdr lst))
+         (elem (car lst) (car lst))
+         (last-elem (null (cdr lst)) (null (cdr lst))))
+        ((null lst))
+      (write-string elem strm)
+      (unless (and last-elem last-list)
+       (write-string separator strm)))))
+
+(defun col-value (col value)
+  (if (eq (umls-col-datatype col) 'sql-u)
+      (write-to-string (parse-ui value ""))
+      (escape-backslashes value)))
+
+(defun umls-translate (file line strm)
   "Translate a single line for sql output"
-  (format nil "~{~A~^|~}"
-         (append
-          (mapcar
-           (lambda (col value)
-             (concatenate
-              'string
-              (if (eq (umls-col-datatype col) 'sql-u)
-                  (format nil "~d" (parse-ui value ""))
-                  (escape-backslashes value))))
-           (remove-custom-cols (umls-file-colstructs file)) 
-           line)
-         (custom-col-values (custom-colstructs-for-file file) line nil))))
+  (print-separated-strings
+   strm "|" 
+   (mapcar #'col-value (remove-custom-cols (umls-file-colstructs file)) line)
+   (custom-col-values (custom-colstructs-for-file file) line nil)))
    
 
 ;;; Routines for analyzing cost of fixed size storage