From: Kevin M. Rosenberg Date: Tue, 6 May 2003 07:44:07 +0000 (+0000) Subject: r4842: Auto commit for Debian build X-Git-Tag: v2006ac.2~184 X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=4e62898eedb688c0a44bd257cbcdee07f11ac058 r4842: Auto commit for Debian build --- diff --git a/parse-2002.lisp b/parse-2002.lisp index 8bbb009..a42d5b8 100644 --- a/parse-2002.lisp +++ b/parse-2002.lisp @@ -5,10 +5,10 @@ ;;;; Name: parse-2002.lisp ;;;; Purpose: Parsing and SQL insertion routines for UMLisp which may ;;;; change from year to year -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: parse-2002.lisp,v 1.7 2003/05/06 07:17:35 kevin Exp $ +;;;; $Id: parse-2002.lisp,v 1.8 2003/05/06 07:44:07 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -17,8 +17,10 @@ ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:umlisp) + +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))) ;;; Pre-read data for custom fields into hash tables (defvar *parse-hash-init?* nil) @@ -379,16 +381,16 @@ append a unique number (starting at 2) onto a column name that is repeated in th :fields (concatenate 'list (umls-field-string-to-list fmt) (custom-colnames-for-filename fil))))) - (setf (ucols f) (ucols-for-umls-file f)) + (setf (ucols f) (ucols-for-ufile f)) (push f files)))) (nreverse files))) (defun init-custom-files () (let ((ffile (make-instance 'ufile :fil "MRXW.NONENG" :des "Custom NonEnglish Index" :table "MRXW_NONENG" - :cls 5 :rws 0 :bts 0 :fields (fields (find-umls-file "MRXW.ENG"))))) + :cls 5 :rws 0 :bts 0 :fields (fields (find-ufile "MRXW.ENG"))))) (setf (ucols ffile) - (ucols-for-umls-file ffile)) + (ucols-for-ufile ffile)) (list ffile))) (defun datatype-for-col (colname) diff --git a/parse-common.lisp b/parse-common.lisp index 1e397bf..07e5cc9 100644 --- a/parse-common.lisp +++ b/parse-common.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: parse-common.lisp ;;;; Purpose: Common, stable parsing routines for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: parse-common.lisp,v 1.7 2003/05/06 07:17:35 kevin Exp $ +;;;; $Id: parse-common.lisp,v 1.8 2003/05/06 07:44:07 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -86,7 +86,7 @@ Currently, these are the LEX and NET files." (let* ((filename (car length-list)) (max-field (cadr length-list)) (av-field (caddr length-list)) - (file (find-umls-file filename))) + (file (find-ufile filename))) (when file (if (/= (length max-field) (length (fields file))) (format t "Warning: Number of file fields ~A doesn't match length of fields in file structure ~S" @@ -94,7 +94,7 @@ Currently, these are the LEX and NET files." (dotimes (i (max (length max-field) (length (fields file)))) (declare (fixnum i)) (let* ((field (nth i (fields file))) - (col (find-umls-col field filename))) + (col (find-ucol field filename))) (if col (progn (setf (cmax col) (aref max-field i)) @@ -158,18 +158,18 @@ Currently, these are the LEX and NET files." (push new-col *umls-cols*) new-col)))))) -(defun find-umls-col (colname filename) +(defun find-ucol (colname filename) "Returns list of umls-col structure for a column name and a filename" (find-or-make-col-in-columns colname filename *umls-cols*)) -(defun find-umls-file (filename) +(defun find-ufile (filename) "Returns umls-file structure for a filename" (find-if (lambda (f) (string-equal filename (fil f))) *umls-files*)) -(defun ucols-for-umls-file (file) +(defun ucols-for-ufile (file) "Returns list of umls-cols for a file structure" (let ((filename (fil file))) - (mapcar (lambda (col) (find-umls-col col filename)) + (mapcar (lambda (col) (find-ucol col filename)) (fields file)))) diff --git a/sql-create.lisp b/sql-create.lisp index af0dd99..06c5a26 100644 --- a/sql-create.lisp +++ b/sql-create.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: sql-create ;;;; Purpose: Create SQL database for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-create.lisp,v 1.19 2003/05/06 07:17:35 kevin Exp $ +;;;; $Id: sql-create.lisp,v 1.20 2003/05/06 07:44:07 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -34,7 +34,7 @@ (format nil "~a (~a)" sqltype (cmax c)) sqltype)))))) (format nil "CREATE TABLE ~a (~{~a~^,~})" (table file) - (mapcar col-func (ucols-for-umls-file file))))) + (mapcar col-func (ucols-for-ufile file))))) (defun create-custom-table-cmd (tablename sql-cmd) "Return SQL command to create a custom table" @@ -85,7 +85,6 @@ (find-if (lambda (x) (and (string-equal filename (car x)) (string-equal col (cadr x)))) +custom-cols+)) - (defun custom-colnames-for-filename (filename) (mapcar #'cadr (find-custom-cols-for-filename filename))) @@ -196,21 +195,22 @@ This is much faster that using create-umls-db-insert." (defun translate-umls-file (file extension) "Translate a umls file into a format suitable for sql copy cmd" - (translate-files (fil file) extension (list file))) + (translate-files file extension (list file))) (defun make-noneng-index-file (extension) "Make non-english index file" - (translate-files "MRXW.NONENG" extension (noneng-lang-index-files))) + (translate-files (find-ufile "MRXW.NONENG") + extension (noneng-lang-index-files))) -(defun translate-files (output-basename extension input-files) +(defun translate-files (out-ufile extension input-ufiles) "Translate a umls file into a format suitable for sql copy cmd" - (let ((output-path (umls-pathname output-basename extension))) + (let ((output-path (umls-pathname (fil out-ufile) extension))) (if (probe-file output-path) (format t "File ~A already exists: skipping~%" output-path) (with-open-file (ostream output-path :direction :output) - (dolist (input-file input-files) - (with-umls-file (line (fil input-file)) - (umls-translate input-file line ostream) + (dolist (input-ufile input-ufiles) + (with-umls-file (line (fil input-ufile)) + (umls-translate out-ufile line ostream) (princ #\newline ostream))))))) (defun pg-copy-cmd (file extension)