diff options
author | Andy Wingo <wingo@pobox.com> | 2013-11-08 10:59:52 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-11-08 10:59:52 +0100 |
commit | be564260bef9b2d0f9df64affdbcf7e9b02507d2 (patch) | |
tree | a24e882e06674a638a9a626f814010512e15e774 /module | |
parent | 6a59420a9d5ed5a3ee054f9de5615c577d1ec651 (diff) | |
download | guile-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.scm | 14 |
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 |