aboutsummaryrefslogtreecommitdiff
path: root/macros.scm
blob: 71ae12e8b804d6981a0a6f6b8b76d3c8c8ef1e34 (plain)
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))]))