* Added macro writer for #` #, and #,@ forms.
This commit is contained in:
parent
1864ca830b
commit
eabfc3fe4f
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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 ...)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue