add scheme apply, rename apply-> apply_env.
[mes.git] / syntax.mes
1
2 (display "define-syntax...")
3
4 (define-macro define-syntax
5   (lambda (form expander)
6     (expander `(define-macro ,(cadr form)
7                  (let ((transformer ,(caddr form)))
8                    (lambda (form expander)
9                      (expander (transformer form
10                                             (lambda (x) x)
11                                             eq?)
12                                expander))))
13               expander)))
14
15 (newline)
16
17 (display "define-syntax when...")
18
19 ;; (define-syntax when
20 ;;   (syntax-rules ()
21 ;;     ((when condition exp ...)
22 ;;      (if condition
23 ;;          (begin exp ...)))))
24
25 ;; (define-macro (when cond exp . rest)
26 ;;   `(if ,cond
27 ;;        (begin ,exp . ,rest)))
28
29
30 (define-macro (when clause . rest)
31   (cond
32    ((not (eq? clause #f)) (cons 'let (cons '() rest)))))
33
34 (define-macro (ifwhen clause . rest)
35   (if (not (eq? clause #f)) (cons 'let (cons '() rest))))
36
37 (define-macro my-when
38   (lambda (test . branch)
39     (list 'if test (cons 'begin branch))))
40
41 ;; (define-macro (q-when test . branch)
42 ;;   `(if ,test
43 ;;        (begin ,@branch)))
44
45 ;; (define-macro (when clause exp . rest)
46 ;;   (display "all=")
47 ;;   (display  (cons exp rest))
48 ;;   (newline)
49 ;;   `(if ,clause
50 ;;        (begin ,(cons exp rest))))
51
52 ;; (define-macro (when clause . rest)
53 ;;   (cond
54 ;;    ((not (eq? clause #f)) (cons 'let (cons '() rest)))))
55
56 (newline)
57
58 (ifwhen #t
59   (display "true")
60   (newline))
61
62 (ifwhen #f
63   (display "false")
64   (newline)
65   '())
66
67 (my-when #t
68   (display "my-when")
69   (newline)
70   '())
71
72
73 ;; (q-when #t
74 ;;   (display "q-when")
75 ;;   (newline)
76 ;;   '())
77
78
79 (define *gensym* 0)
80 (define (gensym)
81   (set! *gensym* (+ *gensym* 1))
82   (string->symbol (string-append "g" (number->string *gensym*))))
83
84 (define-macro bla (gensym))
85
86 (display bla) (newline)
87 (display bla) (newline)
88 (display bla) (newline)
89
90 (newline)
91 '()
92
93 ;;EOF
94 EOF2