summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-22 17:43:36 +0200
committerAndy Wingo <wingo@pobox.com>2011-09-24 17:09:40 +0200
commitc829531a4652b2cf4d4aac1eb0af08c3231bdecf (patch)
treee12a9c28087b05fab6615e236345001ba03da67e
parenta4c7fe5cde907f3bc4cbc5190bfc7e748d6bac45 (diff)
downloadguile-c829531a4652b2cf4d4aac1eb0af08c3231bdecf.tar.gz
fix alpha-rename for kwargs
* module/language/tree-il/optimize.scm (alpha-rename): Fix alpha-renaming of keyword arguments.
-rw-r--r--module/language/tree-il/optimize.scm14
1 files changed, 12 insertions, 2 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 0cc51a0b9..848b7e92d 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -65,9 +65,19 @@ references to the new symbols."
(append req
(or opt '())
(if rest (list rest) '())
- (if kw (map cadr (cdr kw)) '()))))
+ (match kw
+ ((aok? (_ name _) ...) name)
+ (_ '())))))
(mapping (fold vhash-consq mapping gensyms new)))
- (make-lambda-case src req opt rest kw inits new
+ (make-lambda-case src req opt rest
+ (match kw
+ ((aok? (kw name old) ...)
+ (cons aok? (map list
+ kw
+ name
+ (take-right new (length old)))))
+ (_ #f))
+ inits new
(loop body mapping)
(and alt (loop alt mapping)))))
(($ <lexical-ref> src name gensym)