procedure-arity: fix bug in non-JIT mode
The arity calculation for a `case-lambda` as a `prop:procedure` argument did not drop the self argument as it should.
This commit is contained in:
parent
696e9143a6
commit
c05b9409d5
|
@ -42,6 +42,11 @@
|
|||
(define (f1:a?:b? x #:a [a 0] #:b [b 1]) (list x a b))
|
||||
(define (f1+:a:b? x #:a a #:b [b 1] . args) (list* x a b args))
|
||||
(define (f1+:a?:b? x #:a [a 0] #:b [b 1] . args) (list* x a b args))
|
||||
(define (f1+2:a:b x [y #f] #:a a #:b b) (if y
|
||||
(if (number? x)
|
||||
(list x y a b)
|
||||
(list y a b))
|
||||
(list x a b)))
|
||||
(define f_ (case-lambda))
|
||||
(define f_1_2 (case-lambda
|
||||
[(x) (list x)]
|
||||
|
@ -89,6 +94,8 @@
|
|||
(,(wrap-m f1+:a/drop) ,(make-arity-at-least 0) (#:a) (#:a))
|
||||
(,(wrap-m f1+:a?/drop) ,(make-arity-at-least 0) () (#:a))
|
||||
(,(procedure->method (wrap f1+:a?)) ,(make-arity-at-least 1) () (#:a) #t)
|
||||
(,f1+2:a:b (1 2) (#:a #:b) (#:a #:b))
|
||||
(,(wrap-m f1+2:a:b) (0 1) (#:a #:b) (#:a #:b))
|
||||
(,f0:a:b 0 (#:a #:b) (#:a #:b))
|
||||
(,f0:a?:b 0 (#:b) (#:a #:b))
|
||||
(,f1:a:b 1 (#:a #:b) (#:a #:b))
|
||||
|
|
|
@ -1880,7 +1880,7 @@ static Scheme_Object *get_or_check_arity(Scheme_Object *p, intptr_t a, Scheme_Ob
|
|||
}
|
||||
|
||||
if ((a == -1) || (a == -3) || (a == -4)) {
|
||||
if (drop && (a == -4))
|
||||
if (drop)
|
||||
mask = shift_for_drop(mask, drop);
|
||||
if (a != -4)
|
||||
return mask_to_arity(mask, a);
|
||||
|
|
Loading…
Reference in New Issue
Block a user