summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-11-08 10:59:52 +0100
committerAndy Wingo <wingo@pobox.com>2013-11-08 10:59:52 +0100
commitbe564260bef9b2d0f9df64affdbcf7e9b02507d2 (patch)
treea24e882e06674a638a9a626f814010512e15e774 /module
parent6a59420a9d5ed5a3ee054f9de5615c577d1ec651 (diff)
downloadguile-be564260bef9b2d0f9df64affdbcf7e9b02507d2.tar.gz
Fix arity selection in compute-contification
* module/language/cps/contification.scm (compute-contification): Fail as soon as we see an arity with rest, optional, or keyword arguments. Fixes ((case-lambda ((a . b) #t) ((a b) #f)) 1 2).
Diffstat (limited to 'module')
-rw-r--r--module/language/cps/contification.scm14
1 files changed, 9 insertions, 5 deletions
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 6e8fe621d..7a9252e95 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -84,11 +84,15 @@
;; Are the given args compatible with any of the arities?
(define (applicable? proc args)
- (or-map (match-lambda
- (($ $arity req () #f () #f)
- (= (length args) (length req)))
- (_ #f))
- (assq-ref (map cons syms arities) proc)))
+ (let lp ((arities (assq-ref (map cons syms arities) proc)))
+ (match arities
+ ((($ $arity req () #f () #f) . arities)
+ (or (= (length args) (length req))
+ (lp arities)))
+ ;; If we reached the end of the arities, fail. Also fail if
+ ;; the next arity in the list has optional, keyword, or rest
+ ;; arguments.
+ (_ #f))))
;; If the use of PROC in continuation USE is a call to PROC that
;; is compatible with one of the procedure's arities, return the