Commit | Line | Data |
---|---|---|
0bf4a5fc | 1 | ;;;; and-let-star.scm --- and-let* syntactic form (SRFI-2) for Guile |
93a6e9c4 | 2 | ;;;; |
0bf4a5fc | 3 | ;;;; Copyright (C) 1999, 2001, 2004, 2006, 2013 Free Software Foundation, Inc. |
93a6e9c4 | 4 | ;;;; |
73be1d9e MV |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
93a6e9c4 | 9 | ;;;; |
73be1d9e | 10 | ;;;; This library is distributed in the hope that it will be useful, |
93a6e9c4 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
93a6e9c4 | 14 | ;;;; |
73be1d9e MV |
15 | ;;;; You should have received a copy of the GNU Lesser General Public |
16 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
93a6e9c4 | 18 | |
1a179b03 MD |
19 | (define-module (ice-9 and-let-star) |
20 | :export-syntax (and-let*)) | |
93a6e9c4 | 21 | |
0bf4a5fc MW |
22 | (define-syntax %and-let* |
23 | (lambda (form) | |
24 | (syntax-case form () | |
25 | ((_ orig-form ()) | |
26 | #'#t) | |
27 | ((_ orig-form () body bodies ...) | |
28 | #'(begin body bodies ...)) | |
29 | ((_ orig-form ((var exp) c ...) body ...) | |
30 | (identifier? #'var) | |
31 | #'(let ((var exp)) | |
c4b7ba68 | 32 | (and var (%and-let* orig-form (c ...) body ...)))) |
0bf4a5fc MW |
33 | ((_ orig-form ((exp) c ...) body ...) |
34 | #'(and exp (%and-let* orig-form (c ...) body ...))) | |
35 | ((_ orig-form (var c ...) body ...) | |
36 | (identifier? #'var) | |
37 | #'(and var (%and-let* orig-form (c ...) body ...))) | |
38 | ((_ orig-form (bad-clause c ...) body ...) | |
39 | (syntax-violation 'and-let* "Bad clause" #'orig-form #'bad-clause))))) | |
93a6e9c4 | 40 | |
0bf4a5fc MW |
41 | (define-syntax and-let* |
42 | (lambda (form) | |
43 | (syntax-case form () | |
44 | ((_ (c ...) body ...) | |
45 | #`(%and-let* #,form (c ...) body ...))))) | |
b4c0da9c KR |
46 | |
47 | (cond-expand-provide (current-module) '(srfi-2)) |