X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=parse-macros.lisp;h=67af3c6ddd2f51806a86f035898fba5b144a6ce7;hb=90dcc29376b4e52a1ba4b7b86dd19ce9f81be4c5;hp=bf784c202e25432b00fc7501c90918464a07bfdd;hpb=99157b76d436e731d8488760fd8c745bb63f0c2d;p=umlisp.git diff --git a/parse-macros.lisp b/parse-macros.lisp index bf784c2..67af3c6 100644 --- a/parse-macros.lisp +++ b/parse-macros.lisp @@ -10,7 +10,7 @@ ;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2004 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. @@ -22,51 +22,58 @@ "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)))) + eof + (delimited-string-to-list line #\| t)))) (defun source-files (path) - (if (probe-file 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) - "")))) + :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)))))) + (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-"))) + (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) - (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))))) + (,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-"))) + (eof (gensym "EOF-")) + (files (gensym "FILES-"))) `(let ((,eof (gensym "EOFSYM-")) - (,files (source-files ,path))) - (with-open-file (,ustream (first ,files) :direction :input) - (do ((,line (read-umls-line ,ustream ,eof) - (read-umls-line ,ustream ,eof))) - ((eq ,line ,eof) t) - ,@body))))) + (,files (source-files ,path))) + (unless ,files + (error "Can't find files for ~A~%" (namestring ,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) + (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" @@ -81,15 +88,15 @@ (defmacro with-buffered-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-"))) + (buffer (gensym "BUF-")) + (eof (gensym "EOF-"))) `(let ((,buffer (make-fields-buffer)) - (,eof (gensym "EOFSYM-"))) + (,eof (gensym "EOFSYM-"))) (with-open-file - (,ustream (umls-pathname ,filename) :direction :input) - (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof) - (read-buffered-fields ,buffer ,ustream #\| ,eof))) - ((eq ,line ,eof) t) - ,@body))))) + (,ustream (umls-pathname ,filename) :direction :input) + (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof) + (read-buffered-fields ,buffer ,ustream #\| ,eof))) + ((eq ,line ,eof) t) + ,@body)))))