* Added macro writer for #` #, and #,@ forms.

This commit is contained in:
Abdulaziz Ghuloum 2007-08-30 20:30:21 -04:00
parent 1864ca830b
commit eabfc3fe4f
3 changed files with 25 additions and 12 deletions

Binary file not shown.

View File

@ -506,6 +506,9 @@
(set-fmt! 'unquote-splicing '(read-macro . ",@"))
(set-fmt! 'quasiquote '(read-macro . "`"))
(set-fmt! 'syntax '(read-macro . "#'"))
(set-fmt! 'quasisyntax '(read-macro . "#`"))
(set-fmt! 'unsyntax '(read-macro . "#,"))
(set-fmt! 'unsyntax-splicing '(read-macro . "#,@"))
(set-fmt! '|#primitive| '(read-macro . "#%"))
(set-fmt! 'let '(alt
(_ (0 [e 0 e] ...) tab e ...)

View File

@ -421,27 +421,37 @@
(loop x 0 (string-length x) p)))
(define macro
(lambda (x)
(lambda (x h)
(define macro-forms
'([quote . "'"]
[quasiquote . "`"]
[unquote . ","]
[unquote-splicing . ",@"]
[syntax . "#'"]
'([quote . "'"]
[quasiquote . "`"]
[unquote . ","]
[unquote-splicing . ",@"]
[syntax . "#'"]
[quasisyntax . "#`"]
[unsyntax . "#,"]
[unsyntax-splicing . "#,@"]
[|#primitive| . "#%"]))
(and (pair? x)
(let ([d ($cdr x)])
(and (pair? d)
(null? ($cdr d))))
(null? ($cdr d))
(not (get-hash-table h x #f))))
(assq ($car x) macro-forms))))
(define write-pair
(lambda (x p m h i)
(write-char #\( p)
(let ([i (writer (car x) p m h i)])
(let ([i (write-list (cdr x) p m h i)])
(write-char #\) p)
i))))
(cond
[(macro x h) =>
(lambda (a)
(display (cdr a) p)
(writer (cadr x) p m h i))]
[else
(write-char #\( p)
(let ([i (writer (car x) p m h i)])
(let ([i (write-list (cdr x) p m h i)])
(write-char #\) p)
i))])))
(define write-ref
(lambda (n p)