1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: parse-macros.lisp
6 ;;;; Purpose: Macros for UMLS file parsing
7 ;;;; Author: Kevin M. Rosenberg
10 ;;;; This file, part of UMLisp, is
11 ;;;; Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D.
13 ;;;; UMLisp users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the GNU General Public License.
15 ;;;; *************************************************************************
19 (defun read-umls-line (strm &optional (eof 'eof))
20 "Read a line from a UMLS stream, split into fields"
21 (let ((line (read-line strm nil eof)))
24 (delimited-string-to-list line #\| t))))
26 (defun source-files (path)
30 (directory (make-pathname :defaults path
32 :name (concatenate 'string (pathname-name path)
33 (aif (pathname-type path)
34 (concatenate 'string "." it)
37 (string-lessp (pathname-type a) (pathname-type b))))))
39 (defmacro with-buffered-reading-umls-file ((line path) &body body)
40 "Opens a UMLS and processes each parsed line with (body) argument"
41 (let ((ustream (gensym "STRM-"))
42 (buffer (gensym "BUF-"))
44 (files (gensym "FILES-")))
45 `(let ((,eof (gensym "EOFSYM-"))
46 (,buffer (make-fields-buffer))
47 (,files (source-files ,path)))
48 (with-open-file (,ustream (first ,files) :direction :input
49 #+(and sbcl sb-unicode) :external-format
50 #+(and sbcl sb-unicode) :UTF-8
51 #+(and allegro ics) :external-format
52 #+(and allegro ics) :UTF-8
53 #+lispworks :external-format
55 #+(and clisp unicode) :external-format
56 #+(and clisp unicode) charset:utf-8)
57 (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
58 (read-buffered-fields ,buffer ,ustream #\| ,eof)))
60 (setq ,line (coerce ,line 'list))
64 (defmacro with-reading-umls-file ((line path) &body body)
65 "Opens a UMLS and processes each parsed line with (body) argument"
66 (let ((ustream (gensym "STRM-"))
68 (files (gensym "FILES-")))
69 `(let ((,eof (gensym "EOFSYM-"))
70 (,files (source-files ,path)))
72 (error "Can't find files for ~A~%" (namestring ,path)))
73 (with-open-file (,ustream (first ,files) :direction :input
74 #+(and sbcl sb-unicode) :external-format
75 #+(and sbcl sb-unicode) :UTF-8
76 #+(and allegro ics) :external-format
77 #+(and allegro ics) :UTF-8
78 #+lispworks :external-format
80 #+(and clisp unicode) :external-format
81 #+(and clisp unicode) charset:utf-8)
82 (do ((,line (read-umls-line ,ustream ,eof)
83 (read-umls-line ,ustream ,eof)))
85 (locally (declare (type list ,line))
88 (defmacro with-umls-ufile ((line ufile) &body body)
89 "Opens a UMLS and processes each parsed line with (body) argument"
90 `(with-reading-umls-file (,line (ufile-pathname ,ufile))
93 (defmacro with-umls-file ((line ufile) &body body)
94 "Opens a UMLS and processes each parsed line with (body) argument"
95 `(with-reading-umls-file (,line (umls-pathname ,ufile))
98 (defmacro with-buffered-umls-file ((line filename) &body body)
99 "Opens a UMLS and processes each parsed line with (body) argument"
100 (let ((ustream (gensym "STRM-"))
101 (buffer (gensym "BUF-"))
102 (eof (gensym "EOF-")))
103 `(let ((,buffer (make-fields-buffer))
104 (,eof (gensym "EOFSYM-")))
106 (,ustream (umls-pathname ,filename) :direction :input
107 #+(and sbcl sb-unicode) :external-format
108 #+(and sbcl sb-unicode) :UTF-8
109 #+(and allegro ics) :external-format
110 #+(and allegro ics) :UTF-8
111 #+lispworks :external-format
113 #+(and clisp unicode) :external-format
114 #+(and clisp unicode) charset:utf-8)
115 (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
116 (read-buffered-fields ,buffer ,ustream #\| ,eof)))