X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=parse-macros.lisp;h=a2af75ef7a7bf38a66c015c315825d86b2cc3974;hp=224496bc58efca1dc3f15a7523f508860e6457e7;hb=57c4b059639968903aec88e65103a7263cb97535;hpb=cdd0b5094e4db943ad6c9f79018f1dcd4f5bc205 diff --git a/parse-macros.lisp b/parse-macros.lisp index 224496b..a2af75e 100644 --- a/parse-macros.lisp +++ b/parse-macros.lisp @@ -2,15 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: parse-macros.lisp -;;;; Purpose: Macros for UMLS file parsing -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 +;;;; Name: parse-macros.lisp +;;;; Purpose: Macros for UMLS file parsing +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; -;;;; $Id: parse-macros.lisp,v 1.5 2003/05/06 02:19:46 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2006 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. @@ -18,18 +18,71 @@ (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)))) -(defmacro with-umls-file ((line filename) &body body) -"Opens a UMLS and processes each parsed line with (body) argument" +(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-")) - (eof (gensym "EOF-"))) - `(let ((,eof (gensym "EOFSYM-"))) - (with-open-file - (,ustream (umls-pathname ,filename) :direction :input) - (do ((,line (read-umls-line ,ustream ,eof) - (read-umls-line ,ustream ,eof))) - ((eq ,line ,eof) t) - ,@body))))) + (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 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-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 file files for ~A~%" ,path)) + (with-open-file (,ustream (first ,files) :direction :input + #+(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) + ,@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" @@ -45,17 +98,4 @@ ((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 "STRM-")) - (buffer (gensym "BUF-")) - (eof (gensym "EOF-"))) - `(let ((,buffer (make-fields-buffer2)) - (,eof (gensym "EOFSYM-"))) - (with-open-file - (,ustream (umls-pathname ,filename) - :direction :input :if-exists :overwrite) - (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof) - (read-buffered-fields ,buffer ,ustream #\| ,eof))) - ((eq ,line ,eof) t) - ,@body))))) +