forked from dbetz/xlisp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathqquote.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)))))