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

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

3
src/ikarus.pretty-print.ss
View File

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

34
src/ikarus.writer.ss
View File

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