conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixes bug 192222: Quasiquote broken

This commit is contained in:
Abdulaziz Ghuloum 2008-02-15 15:25:20 -05:00
parent 30aae80c5d
commit 19e5d2bacd
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
scheme/psyntax.expander.ss
View File

@ -1457,6 +1457,8 @@
(define quasiquote-macro (define quasiquote-macro
(let () (let ()
(define (datum x)
(list (scheme-stx 'quote) (mkstx x '() '() '())))
(define-syntax app (define-syntax app
(syntax-rules (quote) (syntax-rules (quote)
((_ 'x arg* ...) ((_ 'x arg* ...)
@ -1519,7 +1521,7 @@
(if (= lev 0) (if (= lev 0)
(quasicons* p (vquasi q lev)) (quasicons* p (vquasi q lev))
(quasicons (quasicons
(quasicons (app 'quote 'unquote) (quasicons (datum 'unquote)
(quasi p (- lev 1))) (quasi p (- lev 1)))
(vquasi q lev)))) (vquasi q lev))))
((unquote-splicing p ...) ((unquote-splicing p ...)
@ -1527,7 +1529,7 @@
(quasiappend p (vquasi q lev)) (quasiappend p (vquasi q lev))
(quasicons (quasicons
(quasicons (quasicons
(app 'quote 'unquote-splicing) (datum 'unquote-splicing)
(quasi p (- lev 1))) (quasi p (- lev 1)))
(vquasi q lev)))) (vquasi q lev))))
(p (quasicons (quasi p lev) (vquasi q lev))))) (p (quasicons (quasi p lev) (vquasi q lev)))))
@ -1538,23 +1540,24 @@
((unquote p) ((unquote p)
(if (= lev 0) (if (= lev 0)
p p
(quasicons (app 'quote 'unquote) (quasi (list p) (- lev 1))))) (quasicons (datum 'unquote) (quasi (list p) (- lev 1)))))
(((unquote p ...) . q) (((unquote p ...) . q)
(if (= lev 0) (if (= lev 0)
(quasicons* p (quasi q lev)) (quasicons* p (quasi q lev))
(quasicons (quasicons
(quasicons (app 'quote 'unquote) (quasi p (- lev 1))) (quasicons (datum 'unquote)
(quasi p (- lev 1)))
(quasi q lev)))) (quasi q lev))))
(((unquote-splicing p ...) . q) (((unquote-splicing p ...) . q)
(if (= lev 0) (if (= lev 0)
(quasiappend p (quasi q lev)) (quasiappend p (quasi q lev))
(quasicons (quasicons
(quasicons (quasicons (datum 'unquote-splicing)
(app 'quote 'unquote-splicing)
(quasi p (- lev 1))) (quasi p (- lev 1)))
(quasi q lev)))) (quasi q lev))))
((quasiquote p) ((quasiquote p)
(quasicons (app 'quote 'quasiquote) (quasi (list p) (+ lev 1)))) (quasicons (datum 'quasiquote)
(quasi (list p) (+ lev 1))))
((p . q) (quasicons (quasi p lev) (quasi q lev))) ((p . q) (quasicons (quasi p lev) (quasi q lev)))
(#(x ...) (not (stx? x)) (quasivector (vquasi x lev))) (#(x ...) (not (stx? x)) (quasivector (vquasi x lev)))
(p (app 'quote p))))) (p (app 'quote p)))))