3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;; let.mes: This file is part of Mes.
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
21 (define-macro (simple-let bindings . rest)
22 `(,`(lambda ,(map car bindings) ,@rest)
23 ,@(map cadr bindings)))
25 (define-macro (named-let label bindings . rest)
26 `(simple-let ((,label *unspecified*))
27 (set! ,label (lambda ,(map car bindings) ,@rest))
28 (,label ,@(map cadr bindings))))
30 (define-macro (let bindings-or-label . rest)
31 `(`,(if ,(symbol? bindings-or-label)
32 (list 'lambda '() (cons* 'named-let ,bindings-or-label ,(car rest) ,(cdr rest)))
33 (list 'lambda '() (cons* 'simple-let ,bindings-or-label ,rest)))))
35 (define-macro (xsimple-let bindings rest)
36 `(,`(lambda ,(map car bindings) ,@rest)
37 ,@(map cadr bindings)))
39 (define-macro (xnamed-let label bindings rest)
40 `(simple-let ((,label *unspecified*))
41 (set! ,label (lambda ,(map car bindings) ,@rest))
42 (,label ,@(map cadr bindings))))
45 (define-macro (let bindings-or-label . rest)
46 `(if ,(symbol? bindings-or-label) ;; IF
47 (xnamed-let ,bindings-or-label ,(car rest) ,(cdr rest))
48 (xsimple-let ,bindings-or-label ,rest)))
50 (define (expand-let* bindings body)
53 `((lambda (,(caar bindings))
54 ,(expand-let* (cdr bindings) body))
57 (define-macro (let* bindings . body)
58 (expand-let* bindings body))
60 (define (unspecified-bindings bindings params)
61 (if (null? bindings) params
64 (append params (cons (cons (caar bindings) '(*unspecified*)) '())))))
66 (define (letrec-setters bindings setters)
67 (if (null? bindings) setters
68 (letrec-setters (cdr bindings)
70 (cons (cons 'set! (car bindings)) '())))))
72 (define-macro (letrec bindings . body)
73 `(let ,(unspecified-bindings bindings '())
74 ,@(letrec-setters bindings '())