1 | (use srfi-1) |
---|
2 | (begin-for-syntax (import extras)) |
---|
3 | |
---|
4 | (define-syntax bind-pair |
---|
5 | (ir-macro-transformer |
---|
6 | (lambda (e i c) |
---|
7 | (let* ((b (second e)) |
---|
8 | (exp (third e)) |
---|
9 | (body (drop e 3))) |
---|
10 | `(let* ((x ,exp) |
---|
11 | (,(first b) (car x)) |
---|
12 | (,(second b) (cdr x))) |
---|
13 | ,@body))))) |
---|
14 | |
---|
15 | (define-syntax foo |
---|
16 | (ir-macro-transformer |
---|
17 | (lambda (e i c) |
---|
18 | `(bind-pair (x y) (cons 'foo-car 'b) (print y))))) |
---|
19 | |
---|
20 | (bind-pair (x y) (cons 1 2) |
---|
21 | (print y)) |
---|
22 | |
---|
23 | (pp (expand '(foo))) |
---|
24 | |
---|
25 | (foo) |
---|
26 | |
---|
27 | ;; $ csi -qbn foo.scm |
---|
28 | ;; 2 |
---|
29 | ;; (##core#let |
---|
30 | ;; ((x40 (cons42 (quote43 foo-car44) (quote43 b45)))) |
---|
31 | ;; (##core#let |
---|
32 | ;; ((x40 (car48 x40))) |
---|
33 | ;; (##core#let ((y41 (cdr49 x40))) (##core#let () (print46 y41))))) |
---|
34 | ;; |
---|
35 | ;; Error: (cdr) bad argument type: foo-car |
---|
36 | ;; |
---|
37 | ;; Call history: |
---|
38 | ;; |
---|
39 | ;; <syntax> (##core#begin (##core#let ((y53 (cdr61 x52))) (##core#let () (print58 y53)))) |
---|
40 | ;; <syntax> (##core#let ((y53 (cdr61 x52))) (##core#let () (print58 y53))) |
---|
41 | ;; <syntax> (##core#begin (##core#let () (print58 y53))) |
---|
42 | ;; <syntax> (##core#let () (print58 y53)) |
---|
43 | ;; <syntax> (##core#begin (print58 y53)) |
---|
44 | ;; <syntax> (print58 y53) |
---|
45 | ;; <syntax> (cdr61 x52) |
---|
46 | ;; <syntax> (car60 x52) |
---|
47 | ;; <syntax> (cons54 (quote55 foo-car56) (quote55 b57)) |
---|
48 | ;; <syntax> (quote55 foo-car56) |
---|
49 | ;; <syntax> (##core#quote foo-car56) |
---|
50 | ;; <syntax> (quote55 b57) |
---|
51 | ;; <syntax> (##core#quote b57) |
---|
52 | ;; <eval> (cons54 (quote55 foo-car56) (quote55 b57)) |
---|
53 | ;; <eval> (car60 x52) |
---|
54 | ;; <eval> (cdr61 x52) <-- |
---|