86 lines
2.6 KiB
Scheme
86 lines
2.6 KiB
Scheme
;;;
|
|
;;; <let.ss> ---- SRFI 5 A compatible let form with signatures and rest arguments
|
|
;;; Time-stamp: <03/04/08 09:56:06 solsona>
|
|
;;;
|
|
;;; Usually, I would add a copyright notice, and the announce that
|
|
;;; this code is under the LGPL licence. Nevertheless, I only did the
|
|
;;; port to PLT Scheme v200, and here is the copyright notice,
|
|
;;; comments, and licence from the original source:
|
|
;;;
|
|
;;; Copyright (C) Andy Gaynor (1999-2003)
|
|
;;;
|
|
;;; The version of my-let here was cleaned up by: Paul Schlie <schlie@attbi.com>.
|
|
|
|
(module let mzscheme
|
|
(provide (rename my-let let))
|
|
|
|
(define-syntax my-let
|
|
(syntax-rules ()
|
|
;; standard
|
|
((my-let () body ...)
|
|
(let () body ...))
|
|
((my-let ((var val) ...) body ...)
|
|
(let ((var val) ...) body ...))
|
|
|
|
;; rest style
|
|
((my-let ((var val) . bindings) body ...)
|
|
(let-loop #f bindings (var) (val) (body ...)))
|
|
|
|
;; signature style
|
|
((my-let (name bindings ...) body ...)
|
|
(let-loop name (bindings ...) () () (body ...)))
|
|
|
|
;; standard named style
|
|
((my-let name (bindings ...) body ...)
|
|
(let-loop name (bindings ...) () () (body ...)))
|
|
|
|
))
|
|
|
|
;; A loop to walk down the list of bindings.
|
|
|
|
(define-syntax let-loop
|
|
(syntax-rules ()
|
|
|
|
; No more bindings - make a LETREC.
|
|
((let-loop name () (vars ...) (vals ...) body)
|
|
((letrec ((name (lambda (vars ...) . body)))
|
|
name)
|
|
vals ...))
|
|
|
|
; Rest binding, no name
|
|
((let-loop #f (rest-var rest-val ...) (var ...) (val ...) body)
|
|
(let ((var val) ... (rest-var (list rest-val ...))) . body))
|
|
|
|
; Process a (var val) pair.
|
|
((let-loop name ((var val) more ...) (vars ...) (vals ...) body)
|
|
(let-loop name (more ...) (vars ... var) (vals ... val) body))
|
|
|
|
; End with a rest variable - make a LETREC.
|
|
((let-loop name (rest-var rest-vals ...) (vars ...) (vals ...) body)
|
|
((letrec ((name (lambda (vars ... . rest-var) . body)))
|
|
name)
|
|
vals ... rest-vals ...))))
|
|
|
|
; Four loops - normal and `signature-style', each with and without a rest
|
|
; binding.
|
|
;
|
|
;(let fibonacci ((n 10) (i 0) (f0 0) (f1 1))
|
|
; (if (= i n)
|
|
; f0
|
|
; (fibonacci n (+ i 1) f1 (+ f0 f1))))
|
|
;
|
|
;(let (fibonacci (n 10) (i 0) (f0 0) (f1 1))
|
|
; (if (= i n)
|
|
; f0
|
|
; (fibonacci n (+ i 1) f1 (+ f0 f1))))
|
|
;
|
|
;(let fibonacci ((n 10) (i 0) . (f 0 1))
|
|
; (if (= i n)
|
|
; (car f)
|
|
; (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
|
|
;
|
|
;(let (fibonacci (n 10) (i 0) . (f 0 1))
|
|
; (if (= i n)
|
|
; (car f)
|
|
; (fibonacci n (+ i 1) (cadr f) (+ (car f) (cadr f)))))
|
|
) |