git.gag.com Git - debian/gnuradio/blob - pmt/src/scheme/gnuradio/macros-etc.scm

   1 ;;; -*- scheme -*-
   2 ;;;
   3 ;;; Copyright 2007 Free Software Foundation, Inc.
   4 ;;;
   5 ;;; This file is part of GNU Radio
   6 ;;;
   7 ;;; GNU Radio is free software; you can redistribute it and/or modify
   8 ;;; it under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3, or (at your option)
  10 ;;; any later version.
  11 ;;;
  12 ;;; GNU Radio is distributed in the hope that it will be useful,
  13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License along
  18 ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  19 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20 ;;;
  21
  22 (define-module (gnuradio macros-etc)
  23   :export (atom? when unless for-each-in-file))
  24
  25 (define (atom? obj)
  26   (not (pair? obj)))
  27
  28 (defmacro when (pred . body)
  29   `(if ,pred (begin ,@body) #f))
  30
  31 (defmacro unless (pred . body)
  32   `(if (not ,pred) (begin ,@body) #f))
  33
  34
  35 (define (for-each-in-file file f)
  36   (let ((port (if (port? file)
  37                   file
  38                   (open-input-file file))))
  39     (letrec
  40      ((loop
  41        (lambda (port form)
  42          (cond ((eof-object? form)
  43                 (when (not (eq? port file))
  44                       (close-input-port port))
  45                 #t)
  46                (else
  47                 (f form)
  48                 (set! form #f)          ; for GC
  49                 (loop port (read port)))))))
  50      (loop port (read port)))))