Should I add cond-expand to boot-9.scm?

[Martin Grabmueller]

Hello list,

I have written a cond-expand (SRFI-0) implementation.  Because of the
nature of this SRFI, it does not make sense to add it as a module,
like the other SRFIs.  It should always (and immediately) be
available.

I have attached my implementation.  Do you think this should go into
boot-9.scm?

Regards,
  'martin

===File ~/cvs/guile/guile-core/srfi/srfi-0.scm==============
;;;; srfi-0.scm --- SRFI-0 definitions for Guile
;;;;
;;;;    Copyright (C) 2001 Free Software Foundation, Inc.
;;;; 
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation; either version 2, or
;;;; (at your option) any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;;; Contributed by Martin Grabmueller, 2001-05-10.
;;;;

;;; Commentary:

;;; This module exports the `cond-expand' form defined in SRFI-0.
;;; This syntactic form expands into different commands or
;;; definitions, depending on the features provided by the Scheme
;;; implementation.
;;;
;;; Syntax:
;;;
;;; <cond-expand>
;;;   --> (cond-expand <cond-expand-clause>+)
;;;     | (cond-expand <cond-expand-clause>* (else <command-or-definition>))
;;; <cond-expand-clause>
;;;   --> (<feature-requirement> <command-or-definition>*)
;;; <feature-requirement>
;;;   --> <feature-identifier>
;;;     | (and <feature-requirement>*)
;;;     | (or <feature-requirement>*)
;;;     | (not <feature-requirement>)
;;; <feature-identifier>
;;;   --> <a symbol which is the name or alias of a SRFI>
;;;
;;; Additionally, this implementation provides the
;;; <feature-identifier>s `guile' and `r5rs', so that programs can
;;; determine the implementation type and the supported standard.
;;;
;;; Currently, the following feature identifiers are supported:
;;;
;;;   guile r5rs srfi-0 srfi-2 srfi-6 srfi-8 srfi-9 srfi-10 srfi-11 srfi-13
;;;   srfi-14 srfi-17 srfi-19
;;;

;;; Code:

(define-module (srfi srfi-0))

(export-syntax cond-expand)

(define-macro (cond-expand clause . clauses)
  (define features
    '(guile r5rs srfi-0 srfi-2 srfi-6 srfi-8 srfi-9 srfi-10 srfi-11 srfi-13
            srfi-14 srfi-17 srfi-19))
  (let ((clauses (cons clause clauses))
        (syntax-error (lambda (cl)
                        (error "invalid clause in `cond-expand'" cl))))
    (letrec
        ((test-clause
          (lambda (clause)
            (cond
              ((symbol? clause)
               (memq clause features))
              ((pair? clause)
               (cond
                 ((eq? 'and (car clause))
                  (let lp ((l (cdr clause)))
                    (cond ((null? l)
                           #t)
                          ((pair? l)
                           (and (test-clause (car l)) (lp (cdr l))))
                          (else
                           (syntax-error clause)))))
                 ((eq? 'or (car clause))
                  (let lp ((l (cdr clause)))
                    (cond ((null? l)
                           #f)
                          ((pair? l)
                           (or (test-clause (car l)) (lp (cdr l))))
                          (else
                           (syntax-error clause)))))
                 ((eq? 'not (car clause))
                  (cond ((not (pair? (cdr clause)))
                         (syntax-error clause))
                        ((pair? (cddr clause))
                         ((syntax-error clause))))
                  (not (test-clause (cadr clause))))
                 (else
                  (syntax-error clause))))
              (else
               (syntax-error clause))))))
      (let lp ((c clauses))
        (cond
          ((null? c)
           (error "Unfulfilled `cond-expand'"))
          ((not (pair? c))
           (syntax-error c))
          ((test-clause (caar c))
           `(begin ,@(cdar c)))
          ((eq? (caar c) 'else)
           (if (pair? (cdr c))
             (syntax-error c))
           `(begin ,@(cdar c)))
          (else
           (lp (cdr c))))))))
============================================================