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-2004 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          (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
  52                      (read-buffered-fields ,buffer ,ustream #\| ,eof)))
  53              ((eq ,line ,eof) t)
  54            (setq ,line (coerce ,line 'list))
  55            (print ,line)
  56            ,@body)))))
  57
  58 (defmacro with-reading-umls-file ((line path) &body body)
  59   "Opens a UMLS and processes each parsed line with (body) argument"
  60   (let ((ustream (gensym "STRM-"))
  61         (eof (gensym "EOF-"))
  62         (files (gensym "FILES-")))
  63     `(let ((,eof (gensym "EOFSYM-"))
  64            (,files (source-files ,path)))
  65        (with-open-file (,ustream (first ,files) :direction :input)
  66          (do ((,line (read-umls-line ,ustream ,eof)
  67                      (read-umls-line ,ustream ,eof)))
  68              ((eq ,line ,eof) t)
  69            ,@body)))))
  70
  71 (defmacro with-umls-ufile ((line ufile) &body body)
  72   "Opens a UMLS and processes each parsed line with (body) argument"
  73   `(with-reading-umls-file (,line (ufile-pathname ,ufile))
  74      ,@body))
  75
  76 (defmacro with-umls-file ((line ufile) &body body)
  77   "Opens a UMLS and processes each parsed line with (body) argument"
  78   `(with-reading-umls-file (,line (umls-pathname ,ufile))
  79      ,@body))
  80
  81 (defmacro with-buffered-umls-file ((line filename) &body body)
  82   "Opens a UMLS and processes each parsed line with (body) argument"
  83   (let ((ustream (gensym "STRM-"))
  84         (buffer (gensym "BUF-"))
  85         (eof (gensym "EOF-")))
  86     `(let ((,buffer (make-fields-buffer))
  87            (,eof (gensym "EOFSYM-")))
  88       (with-open-file
  89           (,ustream (umls-pathname ,filename) :direction :input)
  90         (do ((,line (read-buffered-fields ,buffer ,ustream #\| ,eof)
  91                     (read-buffered-fields ,buffer ,ustream #\| ,eof)))
  92             ((eq ,line ,eof) t)
  93           ,@body)))))
  94
  95