X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=parse-macros.lisp;h=490934fd79fa3836794cceac703a6ef665390849;hp=edccfe8cb046c1d90bc996767b9abe720f4f42c4;hb=6c10979737dc10b0c510b1edfe070346bcac3ff5;hpb=bfdd5c9d3d66970759fcdbee5a51da2ca93ddf06 diff --git a/parse-macros.lisp b/parse-macros.lisp index edccfe8..490934f 100644 --- a/parse-macros.lisp +++ b/parse-macros.lisp @@ -2,55 +2,119 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: parse-macros.lisp -;;;; Purpose: Macros for UMLS file parsing -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 -;;;; -;;;; $Id: parse-macros.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $ +;;;; Name: parse-macros.lisp +;;;; Purpose: Macros for UMLS file parsing +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D. ;;;; ;;;; UMLisp users are granted the rights to distribute and use this software ;;;; 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) + +(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 (eq line eof) + eof + (delimited-string-to-list line #\| t)))) + +(defun source-files (path) + (if (probe-file path) + (list path) + (sort + (directory (make-pathname :defaults path + :type :wild + :name (concatenate 'string (pathname-name path) + (aif (pathname-type path) + (concatenate 'string "." it) + "")))) + #'(lambda (a b) + (string-lessp (pathname-type a) (pathname-type b)))))) +(defmacro with-buffered-reading-umls-file ((line path) &body body) + "Opens a UMLS and processes each parsed line with (body) argument" + (let ((ustream (gensym "STRM-")) + (buffer (gensym "BUF-")) + (eof (gensym "EOF-")) + (files (gensym "FILES-"))) + `(let ((,eof (gensym "EOFSYM-")) + (,buffer (make-fields-buffer)) + (,files (source-files ,path))) + (with-open-file (,ustream (first ,files) :direction :input + #+(and sbcl sb-unicode) :external-format + #+(and sbcl sb-unicode) :UTF-8 + #+(and allegro ics) :external-format + #+(and allegro ics) :UTF-8 + #+lispworks :external-format + #+lispworks :UTF-8 + #+(and clisp unicode) :external-format + #+(and clisp unicode) charset:utf-8) + (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof) + (read-buffered-fields ,buffer ,ustream #\| ,eof))) + ((eq ,line ,eof) t) + (setq ,line (coerce ,line 'list)) + (print ,line) + ,@body))))) -(defmacro with-umls-file ((line filename) &body body) -"Opens a UMLS and processes each parsed line with (body) argument" - (let ((ustream (gensym))) - `(with-open-file - (,ustream (umls-pathname ,filename) - :direction :input :if-exists :overwrite) - (do ((,line (read-umls-line ,ustream) (read-umls-line ,ustream))) - ((eq ,line 'eof) t) - ,@body)))) +(defmacro with-reading-umls-file ((line path) &body body) + "Opens a UMLS and processes each parsed line with (body) argument" + (let ((ustream (gensym "STRM-")) + (eof (gensym "EOF-")) + (files (gensym "FILES-"))) + `(let ((,eof (gensym "EOFSYM-")) + (,files (source-files ,path))) + (unless ,files + (error "Can't find files for ~A~%" (namestring ,path))) + (with-open-file (,ustream (first ,files) :direction :input + #+(and sbcl sb-unicode) :external-format + #+(and sbcl sb-unicode) :UTF-8 + #+(and allegro ics) :external-format + #+(and allegro ics) :UTF-8 + #+lispworks :external-format + #+lispworks :UTF-8 + #+(and clisp unicode) :external-format + #+(and clisp unicode) charset:utf-8) + (do ((,line (read-umls-line ,ustream ,eof) + (read-umls-line ,ustream ,eof))) + ((eq ,line ,eof) t) + (locally (declare (type list ,line)) + ,@body)))))) + +(defmacro with-umls-ufile ((line ufile) &body body) + "Opens a UMLS and processes each parsed line with (body) argument" + `(with-reading-umls-file (,line (ufile-pathname ,ufile)) + ,@body)) + +(defmacro with-umls-file ((line ufile) &body body) + "Opens a UMLS and processes each parsed line with (body) argument" + `(with-reading-umls-file (,line (umls-pathname ,ufile)) + ,@body)) (defmacro with-buffered-umls-file ((line filename) &body body) -"Opens a UMLS and processes each parsed line with (body) argument" - (let ((ustream (gensym)) - (buffer (gensym))) - `(let ((,buffer (make-fields-buffer))) - (with-open-file - (,ustream (umls-pathname ,filename) - :direction :input :if-exists :overwrite) - (do ((,line (read-buffered-fields ,buffer ,ustream) (read-buffered-fields ,buffer ,ustream))) - ((eq ,line 'eof) t) - ,@body))))) - -(defmacro with-buffered2-umls-file ((line filename) &body body) -"Opens a UMLS and processes each parsed line with (body) argument" - (let ((ustream (gensym)) - (buffer (gensym))) - `(let ((,buffer (make-fields-buffer2))) - (with-open-file - (,ustream (umls-pathname ,filename) - :direction :input :if-exists :overwrite) - (do ((,line (read-buffered-fields2 ,buffer ,ustream) (read-buffered-fields2 ,buffer ,ustream))) - ((eq ,line 'eof) t) - ,@body))))) + "Opens a UMLS and processes each parsed line with (body) argument" + (let ((ustream (gensym "STRM-")) + (buffer (gensym "BUF-")) + (eof (gensym "EOF-"))) + `(let ((,buffer (make-fields-buffer)) + (,eof (gensym "EOFSYM-"))) + (with-open-file + (,ustream (umls-pathname ,filename) :direction :input + #+(and sbcl sb-unicode) :external-format + #+(and sbcl sb-unicode) :UTF-8 + #+(and allegro ics) :external-format + #+(and allegro ics) :UTF-8 + #+lispworks :external-format + #+lispworks :UTF-8 + #+(and clisp unicode) :external-format + #+(and clisp unicode) charset:utf-8) + (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof) + (read-buffered-fields ,buffer ,ustream #\| ,eof))) + ((eq ,line ,eof) t) + ,@body))))) +