-
Notifications
You must be signed in to change notification settings - Fork 11
/
qquote.lsp
executable file
·45 lines (39 loc) · 1.33 KB
/
qquote.lsp
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
#|
Quasiquote expander for XLISP 3.0
Derived from the code in Appendix C of "Common Lisp" by Guy L. Steele Jr.
without the simplifier for now.
|#
(define (qq-process x)
(cond ((symbol? x)
(list 'quote x))
((atom? x)
x)
((eq? (car x) 'quasiquote)
(qq-process (qq-process (cadr x))))
((eq? (car x) 'unquote)
(cadr x))
((eq? (car x) 'unquote-splicing)
(error ",@ after ` in ~S" (cadr x)))
(else
(let loop ((p x) (q '()))
(if (atom? p)
(cons 'append
(append (reverse q) (list (if (symbol? p) (list 'quote p) p))))
(begin
(if (eq? (car p) 'unquote)
(begin
(if (cddr p) (error "malformed , in ~S" p))
(cons 'append
(append (reverse q) (list (cadr p)))))
(if (eq? (car p) 'unquote-splicing)
(error "dotted ,@ in ~S" p)
(loop (cdr p) (cons (qq-bracket (car p)) q))))))))))
(define (qq-bracket x)
(cond ((atom? x)
(list 'list (qq-process x)))
((eq? (car x) 'unquote)
(list 'list (cadr x)))
((eq? (car x) 'unquote-splicing)
(cadr x))
(else
(list 'list (qq-process x)))))