;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: parse-common.lisp,v 1.3 2002/10/18 03:57:39 kevin Exp $
+;;;; $Id: parse-common.lisp,v 1.6 2003/05/06 01:34:57 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
;;;; 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))))
(defun umls-pathname (filename &optional (extension ""))
"Return pathname for a umls filename"
(pathname
filename)))
-(defun read-umls-line (strm)
+(defun read-umls-line (strm &optional (eof 'eof))
"Read a line from a UMLS stream, split into fields"
- (let ((line (read-line strm nil 'eof)))
- (if (stringp line) ;; ensure not 'eof
- (let* ((len (length line))
- (maybe-remove-terminal ;; LRWD doesn't have '|' at end of line
- (if (char= #\| (char line (1- len)))
- (subseq line 0 (1- len))
- line)))
- (declare (fixnum len))
- (delimited-string-to-list maybe-remove-terminal #\|))
- line)))
-
+ (let ((line (read-line strm nil eof)))
+ (if (eq line eof)
+ eof
+ (delimited-string-to-list line #\| t))))
;;; Find field lengths for LEX and NET files
(umls-file-fields file))))
-;;; Routines for analyzing cost of fixed size storage
-
-(defun umls-fixed-size-waste ()
- "Display storage waste if using all fixed size storage"
- (let ((totalwaste 0)
- (totalunavoidable 0)
- (totalavoidable 0)
- (unavoidable '())
- (avoidable '()))
- (dolist (file *umls-files*)
- (dolist (col (umls-file-colstructs file))
- (let* ((avwaste (- (umls-col-max col) (umls-col-av col)))
- (cwaste (* avwaste (umls-file-rws file))))
- (unless (zerop cwaste)
- (if (<= avwaste 6)
- (progn
- (incf totalunavoidable cwaste)
- (setq unavoidable (append unavoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste)))))
- (progn
- (incf totalavoidable cwaste)
- (setq avoidable (append avoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste))))))
- (incf totalwaste cwaste)))))
- (values totalwaste totalavoidable totalunavoidable avoidable unavoidable)))
-
-(defun display-waste ()
- (unless *umls-files*
- (init-umls))
- (multiple-value-bind (tw ta tu al ul) (umls-fixed-size-waste)
- (format t "Total waste: ~d~%" tw)
- (format t "Total avoidable: ~d~%" ta)
- (format t "Total unavoidable: ~d~%" tu)
- (format t "Avoidable:~%")
- (dolist (w al)
- (format t " (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
- (format t "Unavoidable:~%")
- (dolist (w ul)
- (format t " (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
- ))
-
-(defun max-umls-field ()
- "Return length of longest field"
- (unless *umls-files*
- (init-umls))
- (let ((max 0))
- (declare (fixnum max))
- (dolist (col *umls-cols*)
- (when (> (umls-col-max col) max)
- (setq max (umls-col-max col))))
- max))
-
-(defun max-umls-row ()
- "Return length of longest row"
- (if t
- 6000 ;;; hack to use on systems without MRCOLS/MRFILES -- ok for UMLS2001
- (progn
- (unless *umls-files*
- (init-umls))
- (let ((rowsizes '()))
- (dolist (file *umls-files*)
- (let ((row 0)
- (fields (umls-file-colstructs file)))
- (dolist (field fields)
- (incf row (1+ (umls-col-max field))))
- (push row rowsizes)))
- (car (sort rowsizes #'>))))))