parse-macros.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     parse-macros.lisp
   6 ;;;; Purpose:  Macros for UMLS file parsing
   7 ;;;; Author:   Kevin M. Rosenberg
   8 ;;;; Created:  Apr 2000
   9 ;;;;
  10 ;;;; This file, part of UMLisp, is
  11 ;;;;    Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D.
  12 ;;;;
  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 ;;;; *************************************************************************
  16
  17 (in-package #:umlisp)
  18
  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)))
  22     (if (eq line eof)
  23         eof
  24         (delimited-string-to-list line #\| t))))
  25
  26 (defun source-files (path)
  27   (if (probe-file path)
  28       (list path)
  29     (sort
  30      (directory (make-pathname :defaults path
  31                                :type :wild
  32                                :name (concatenate 'string (pathname-name path)
  33                                                   (aif (pathname-type path)
  34                                                        (concatenate 'string "." it)
  35                                                        ""))))
  36      #'(lambda (a b)
  37          (string-lessp (pathname-type a) (pathname-type b))))))
  38
  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-"))
  43         (eof (gensym "EOF-"))
  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
  54                         #+lispworks :UTF-8
  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)))
  59              ((eq ,line ,eof) t)
  60            (setq ,line (coerce ,line 'list))
  61            (print ,line)
  62            ,@body)))))
  63
  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-"))
  67         (eof (gensym "EOF-"))
  68         (files (gensym "FILES-")))
  69     `(let ((,eof (gensym "EOFSYM-"))
  70            (,files (source-files ,path)))
  71       (unless ,files
  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
  79                                 #+lispworks :UTF-8
  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)))
  84             ((eq ,line ,eof) t)
  85           (locally (declare (type list ,line))
  86                    ,@body))))))
  87
  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))
  91      ,@body))
  92
  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))
  96      ,@body))
  97
  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-")))
 105       (with-open-file
 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
 112                     #+lispworks :UTF-8
 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)))
 117             ((eq ,line ,eof) t)
 118           ,@body)))))
 119
 120