73 lines
2.1 KiB
Scheme
73 lines
2.1 KiB
Scheme
(define-syntax (when expr . forms) `(if ,expr (begin ,@forms) (values)))
|
|
(define-syntax (unless expr . forms) `(if ,expr (values) (begin ,@forms)))
|
|
|
|
(define-syntax (and . terms)
|
|
(if (pair? terms)
|
|
(if (pair? (rest terms))
|
|
(let ([v1 (gensym)])
|
|
`(let ([,v1 ,(first terms)])
|
|
(if ,v1 (and ,@(rest terms)) ,v1)))
|
|
(first terms))
|
|
#t))
|
|
|
|
(define-syntax (or . terms)
|
|
(if (pair? terms)
|
|
(if (pair? (rest terms))
|
|
(let ([v1 (gensym)])
|
|
`(let ([,v1 ,(first terms)])
|
|
(if ,v1 ,v1 (or ,@(rest terms)))))
|
|
(first terms))
|
|
#f))
|
|
|
|
(define-syntax (cond . terms)
|
|
(if (pair? terms)
|
|
(let ([term (first terms)])
|
|
(if (memq? (first term) '(else #t))
|
|
`(begin ,@(rest term))
|
|
`(if ,(first term)
|
|
(begin ,@(rest term))
|
|
(cond ,@(rest terms)))))
|
|
`(values)))
|
|
|
|
(define-syntax (nested wrappers . body)
|
|
(if (eq? wrappers '())
|
|
`(begin ,@body)
|
|
`(,@(first wrappers)
|
|
(nested ,(rest wrappers)
|
|
,@body))))
|
|
|
|
(define-syntax (let* . rst)
|
|
(define (bindings->symbols bindings)
|
|
(if (pair? bindings)
|
|
(let ([binding (car bindings)]
|
|
[other-symbols (bindings->symbols (cdr bindings))])
|
|
(if (pair? (car binding))
|
|
(append (car binding) other-symbols)
|
|
(cons (car binding) other-symbols)))
|
|
'()))
|
|
(define (expand-let* bindings form)
|
|
(if (pair? bindings)
|
|
`(let (,(car bindings))
|
|
,(expand-let* (cdr bindings) form))
|
|
form))
|
|
(if (symbol? (first rst))
|
|
(let ([vars (bindings->symbols (second rst))])
|
|
(expand-let* (second rst)
|
|
`((lambda ,vars ,@(rest (rest rst))) ,@vars)))
|
|
(expand-let* (first rst) `(begin ,@(rest rst)))))
|
|
|
|
(define-syntax (values->list form)
|
|
`(call-with-values
|
|
(lambda () ,form)
|
|
(lambda lst lst)))
|
|
|
|
(define-syntax (parameterize parameters . forms)
|
|
`(call-with-parameters
|
|
(lambda () ,@forms)
|
|
,@(map (lambda (bind) `(list ,@bind)) parameters)))
|
|
|
|
(define-syntax (let/cc var . body)
|
|
`(call/cc (lambda (,var) ,@body)))
|
|
|
|
; vim:set syntax=scheme sw=2 expandtab:
|