blob: 7f745da9c8bde253f3f5be8d61d160a659ea3be0 (
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
46
|
(load "../common")
(defun-match pico-style-expand-hook
((@(as form (@obj . @rest)) @nil nil)
(let ((*expand-hook* nil))
(if (constantp obj)
^(quote ,form)
form)))
((@form @nil @nil) form))
(defmacro pico-style (:env env . body)
(let ((*expand-hook* [expand-hook-combine pico-style-expand-hook
*expand-hook*]))
(expand ^(progn ,*body) env)))
(mtest
(pico-style (1 2 3)) (1 2 3)
(pico-style (let ((a 0)) (cons a (1 2 3)))) (0 1 2 3))
(defun-match infix-expand-hook
((@(as form (@x @y . @rest)) @nil nil)
(if (fboundp y)
^(,y ,x ,*rest)
form))
((@form @nil @nil) form))
(defmacro ifx (:env env . body)
(let ((*expand-hook* [expand-hook-combine infix-expand-hook *expand-hook*]))
(expand ^(progn ,*body) env)))
(test
(ifx (let ((a 1) (b 2) (c 3))
(- ((a + b) * 3))))
-9)
(test
(ifx
(pico-style
((1) cons (2))))
((1) . (2)))
(test
(pico-style
(ifx
((1) cons (2))))
((1) . (2)))
|
