1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
;(use define-record-and-printer)
(use-for-syntax matchable)
;
;(define-syntax defdata
; (ir-macro-transformer
; (lambda (expr inject compare)
; (match expr
; [(_ name . slots)
; `(begin
; (define-record-and-printer ,name ,@slots)
; (define (,name ,@slots)
; (,(inject (symbol-append 'make- name)) ,@slots)))]))))
(define-syntax defdata
(er-macro-transformer
(lambda (expr r compare)
(match expr
[(_ name . slots)
`(,(r 'begin)
(,(r 'define-record-type) ,name (,name ,@slots)
,(symbol-append name '?)
,@(map (lambda (slot)
`(,slot ,(symbol-append name '- slot)))
slots)))]))))
;; A version of 'cond' which supports internal definitions.
(define-syntax cond
(syntax-rules (=> else)
[(cond) (error 'cond "Clauses are not exhaustive")]
[(cond (else body ...)) (let () body ...)]
[(cond (test => fun) rest ...) (let ((tmp test))
(if test
(fun test)
(cond rest ...)))]
[(cond (test body ...) rest ...) (if test
(let ()
body ...)
(cond rest ...))]))
(define-syntax unwind-protect
(syntax-rules ()
[(unwind-protect body after) (dynamic-wind
void
(lambda () body)
(lambda () after))]))
|