;;;; srfi-O.stk -- SRFI-0 aka cond-expand ;;;; ;;;; Copyright © 1999 Erick Gallesio - I3S-CNRS/ESSI ;;;; ;;;; Permission to use, copy, modify, distribute,and license this ;;;; software and its documentation for any purpose is hereby granted, ;;;; provided that existing copyright notices are retained in all ;;;; copies and that this notice is included verbatim in any ;;;; distributions. No written agreement, license, or royalty fee is ;;;; required for any of the authorized uses. ;;;; This software is provided ``AS IS'' without express or implied ;;;; warranty. ;;;; ;;;; This is an implementation of SRFI-0 (Marc Feeley). The implementation is ;;;; a simple adaptation of the one given in in the SRFI document. ;;;; ;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Creation date: 30-Aug-1999 16:26 (eg) ;;;; Last file update: 27-Sep-1999 14:12 (eg) (require "defsyntax") (define-syntax cond-expand (syntax-rules ( and or not else srfi-0 srfi-2 srfi-6 srfi-8 srfi-9) ((cond-expand) (error "Unfulfilled cond-expand")) ((cond-expand (else body ...)) (begin body ...)) ((cond-expand ((and) body ...) more-clauses ...) (begin body ...)) ((cond-expand ((and req1 req2 ...) body ...) more-clauses ...) (cond-expand (req1 (cond-expand ((and req2 ...) body ...) more-clauses ...)) more-clauses ...)) ((cond-expand ((or) body ...) more-clauses ...) (cond-expand more-clauses ...)) ((cond-expand ((or req1 req2 ...) body ...) more-clauses ...) (cond-expand (req1 (begin body ...)) (else (cond-expand ((or req2 ...) body ...) more-clauses ...)))) ((cond-expand ((not req) body ...) more-clauses ...) (cond-expand (req (cond-expand more-clauses ...)) (else body ...))) ;; SRFI 0 -- COND-EXPAND ((cond-expand (srfi-0 body ...) more-clauses ...) (begin body ...)) ;; SRFI 1 -- List primitives ; not final ;; SRFI 2 -- LAND* ((cond-expand (srfi-2 body ...) more-clauses ...) (begin (require "srfi-2") body ...)) ;; SRFI 6 -- String ports ((cond-expand (srfi-6 body ...) more-clauses ...) (begin body ...)) ;; SRFI 8 -- RECEIVE ((cond-expand (srfi-8 body ...) more-clauses ...) (begin body ...)) ;; SRFI 9 -- RECORDS ((cond-expand (srfi-9 body ...) more-clauses ...) (begin body ...)) ((cond-expand (feature-id body ...) more-clauses ...) (cond-expand more-clauses ...)))) (provide "srfi-0")