summaryrefslogtreecommitdiff
path: root/scheme
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-07-19 21:46:27 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-07-19 21:46:27 +0200
commit8c0e353f4ba51d25aa8c823f3e6d8ac4ff1b4779 (patch)
tree11cc0ea3bb1d5dcd58b1e6ce04d3a73a61536d7f /scheme
parenta6df381f547b61ccfb3c572246eb92d5b0839900 (diff)
downloadgeiser-chez-8c0e353f4ba51d25aa8c823f3e6d8ac4ff1b4779.tar.gz
geiser-chez-8c0e353f4ba51d25aa8c823f3e6d8ac4ff1b4779.tar.bz2
Guile: taking advantage of the patterns property in macro transformers.
Diffstat (limited to 'scheme')
-rw-r--r--scheme/guile/geiser/doc.scm15
1 files changed, 14 insertions, 1 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm
index e1e27c1..4bd063b 100644
--- a/scheme/guile/geiser/doc.scm
+++ b/scheme/guile/geiser/doc.scm
@@ -52,10 +52,13 @@
(let ((args-list (map mkargs (if (list? args-list) args-list '()))))
(list id (cons 'args args-list))))
+(define default-macro-args '(((required ...))))
+
(define (obj-args obj)
(cond ((not obj) #f)
((or (procedure? obj) (program? obj)) (arguments obj))
- ((macro? obj) '(((required ...))))
+ ((and (macro? obj) (macro-transformer obj)) => macro-args)
+ ((macro? obj) default-macro-args)
(else 'variable)))
(define (arguments proc)
@@ -79,6 +82,16 @@
`((required . ,(car formals)) (rest . ,(cdr formals))))
(else #f))))
+(define (macro-args tf)
+ (cond ((procedure-property tf 'patterns) =>
+ (lambda (pats)
+ (filter identity
+ (map (lambda (p)
+ (and (every symbol? p)
+ (list (cons 'required p))))
+ pats))))
+ (else default-macro-args)))
+
(define (arity->args art)
(define (gen-arg-names count)
(map (lambda (x) '_) (iota (max count 0))))