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 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of UMLisp, is
  13 ;;;;    Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
  14 ;;;;
  15 ;;;; UMLisp users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the GNU General Public License.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:umlisp)
  20
  21 (defun read-umls-line (strm &optional (eof 'eof))
  22   "Read a line from a UMLS stream, split into fields"
  23   (let ((line (read-line strm nil eof)))
  24     (if (eq line eof)
  25         eof
  26         (delimited-string-to-list line #\| t))))
  27
  28 (defun source-files (path)
  29   (if (probe-file path)
  30       (list path)
  31     (sort
  32      (directory (make-pathname :defaults path
  33                                :type :wild
  34                                :name (concatenate 'string (pathname-name path)
  35                                                   (aif (pathname-type path)
  36                                                        (concatenate 'string "." it)
  37                                                        ""))))
  38      #'(lambda (a b)
  39          (string-lessp (pathname-type a) (pathname-type b))))))
  40
  41 (defmacro with-buffered-reading-umls-file ((line path) &body body)
  42   "Opens a UMLS and processes each parsed line with (body) argument"
  43   (let ((ustream (gensym "STRM-"))
  44         (buffer (gensym "BUF-"))
  45         (eof (gensym "EOF-"))
  46         (files (gensym "FILES-")))
  47     `(let ((,eof (gensym "EOFSYM-"))
  48            (,buffer (make-fields-buffer))
  49            (,files (source-files ,path)))
  50        (with-open-file (,ustream (first ,files) :direction :input
  51                         #+(and clisp unicode) :external-format
  52                         #+(and clisp unicode) charset:utf-8)
  53          (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
  54                      (read-buffered-fields ,buffer ,ustream #\| ,eof)))
  55              ((eq ,line ,eof) t)
  56            (setq ,line (coerce ,line 'list))
  57            (print ,line)
  58            ,@body)))))
  59
  60 (defmacro with-reading-umls-file ((line path) &body body)
  61   "Opens a UMLS and processes each parsed line with (body) argument"
  62   (let ((ustream (gensym "STRM-"))
  63         (eof (gensym "EOF-"))
  64         (files (gensym "FILES-")))
  65     `(let ((,eof (gensym "EOFSYM-"))
  66            (,files (source-files ,path)))
  67       (unless ,files
  68         (error "Can't find file files for ~A~%" ,path))
  69       (with-open-file (,ustream (first ,files) :direction :input
  70                        #+(and clisp unicode) :external-format
  71                        #+(and clisp unicode) charset:utf-8)
  72         (do ((,line (read-umls-line ,ustream ,eof)
  73                     (read-umls-line ,ustream ,eof)))
  74             ((eq ,line ,eof) t)
  75           ,@body)))))
  76
  77 (defmacro with-umls-ufile ((line ufile) &body body)
  78   "Opens a UMLS and processes each parsed line with (body) argument"
  79   `(with-reading-umls-file (,line (ufile-pathname ,ufile))
  80      ,@body))
  81
  82 (defmacro with-umls-file ((line ufile) &body body)
  83   "Opens a UMLS and processes each parsed line with (body) argument"
  84   `(with-reading-umls-file (,line (umls-pathname ,ufile))
  85      ,@body))
  86
  87 (defmacro with-buffered-umls-file ((line filename) &body body)
  88   "Opens a UMLS and processes each parsed line with (body) argument"
  89   (let ((ustream (gensym "STRM-"))
  90         (buffer (gensym "BUF-"))
  91         (eof (gensym "EOF-")))
  92     `(let ((,buffer (make-fields-buffer))
  93            (,eof (gensym "EOFSYM-")))
  94       (with-open-file
  95           (,ustream (umls-pathname ,filename) :direction :input)
  96         (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
  97                     (read-buffered-fields ,buffer ,ustream #\| ,eof)))
  98             ((eq ,line ,eof) t)
  99           ,@body)))))
 100
 101