87 lines
2.5 KiB
Racket
87 lines
2.5 KiB
Racket
;;;
|
|
;;; <let.rkt> ---- 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>.
|
|
;;; Renamed to s:let by Eli Barzilay
|
|
|
|
#lang scheme/base
|
|
(provide s:let)
|
|
|
|
(define-syntax s:let
|
|
(syntax-rules ()
|
|
;; standard
|
|
((s:let () body ...)
|
|
(let () body ...))
|
|
((s:let ((var val) ...) body ...)
|
|
(let ((var val) ...) body ...))
|
|
|
|
;; rest style
|
|
((s:let ((var val) . bindings) body ...)
|
|
(let-loop #f bindings (var) (val) (body ...)))
|
|
|
|
;; signature style
|
|
((s:let (name bindings ...) body ...)
|
|
(let-loop name (bindings ...) () () (body ...)))
|
|
|
|
;; standard named style
|
|
((s: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)))))
|